This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Fortran,patch] Add IMPORT support (PR27546)
- From: Tobias Burnus <burnus at net-b dot de>
- 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>
- Date: Wed, 08 Nov 2006 10:59:44 +0100
- Subject: [Fortran,patch] Add IMPORT support (PR27546)
:ADDPATCH fortran:
The following patch implements the IMPORT statement of Fortran 2003,
which can be used to access derived types via host association:
...
type coordType
sequence
real :: x, y
end coordType
interface
function hypot(coord)
import :: coordType ! or simply "import"
type(coordType) :: coord
end function hypot
end interface
(Of cause, if hypot is written in Fortran, one should use a module.)
Bootstrapped and regression tested (check-gfortran only) on
x86_64-unknown-linux-gnu (openSUSE 10.2beta2).
Tobias
fortran/
2007-11-08 Tobias Burnus <burnus@net-b.de>
PR fortran/27546
* decl.c (gfc_match_import,variable_decl):
Add IMPORT support.
* gfortran.h (gfc_namespace, gfc_statement):
Add IMPORT support.
* parse.c (decode_statement,gfc_ascii_statement,
verify_st_order): Add IMPORT support.
* match.h: Add gfc_match_import.
* gfortran.texi: Add IMPORT to the supported
Fortran 2003 features.
testsuite/
2007-11-08 Tobias Burnus <burnus@net-b.de>
PR fortran/27546
* gfortran.dg/import.f90: Add.
* gfortran.dg/import2.f90: Add.
* gfortran.dg/import3.f90: Add.
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 118545)
+++ gcc/fortran/decl.c (working copy)
@@ -1213,13 +1213,20 @@
/* An interface body specifies all of the procedure's characteristics and these
shall be consistent with those specified in the procedure definition, except
that the interface may specify a procedure that is not pure if the procedure
is defined to be pure(12.3.2). */
if (current_ts.type == BT_DERIVED
&& gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
- && current_ts.derived->ns != gfc_current_ns)
+ && current_ts.derived->ns != gfc_current_ns
+ && !gfc_current_ns->has_import_set)
{
gfc_error ("the type of '%s' at %C has not been declared within the "
"interface", name);
@@ -1482,7 +1489,7 @@
if (gfc_match_char (')') != MATCH_YES)
{
- gfc_error ("Missing right paren at %C");
+ gfc_error ("Missing right parenthesis at %C");
goto no_match;
}
@@ -2004,7 +2011,92 @@
return MATCH_ERROR;
}
+match
+gfc_match_import (void)
+{
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ match m;
+ gfc_symbol *sym;
+ gfc_symtree *st;
+ if (gfc_current_ns->proc_name == NULL ||
+ gfc_current_ns->proc_name->attr.if_source != IFSRC_IFBODY)
+ {
+ gfc_error("IMPORT statement at %C only permitted in "
+ "an INTERFACE body");
+ return MATCH_ERROR;
+ }
+ if (gfc_notify_std (GFC_STD_F2003,
+ "Fortran 2003: IMPORT statement at %C")
+ == FAILURE)
+ return MATCH_ERROR;
+ if (gfc_match_eos () == MATCH_YES)
+ {
+ /* All host variables should be imported */
+ gfc_current_ns->has_import_set = 1;
+ return MATCH_YES;
+ }
+
+ if (gfc_match (" ::") == MATCH_YES)
+ {
+ if (gfc_match_eos () == MATCH_YES)
+ {
+ gfc_error("Expecting list of named entities at %C");
+ return MATCH_ERROR;
+ }
+ }
+
+ for(;;)
+ {
+ m = gfc_match (" %n", name);
+ switch (m)
+ {
+ case MATCH_YES:
+ if (gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
+ {
+ gfc_error ("Type name '%s' at %C is ambiguous", name);
+ return MATCH_ERROR;
+ }
+ if (sym == NULL)
+ {
+ gfc_error("Can not IMPORT '%s' from host scoping unit "
+ "at %C - does not exist.", name);
+ return MATCH_ERROR;
+ }
+ if (gfc_find_symtree(gfc_current_ns->sym_root,name))
+ {
+ gfc_warning("'%s' is already IMPORTed from host scoping unit "
+ "at %C.", name);
+ goto next_item;
+ }
+ st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
+ st->n.sym = sym;
+ sym->refs++;
+ sym->ns = gfc_current_ns;
+
+ goto next_item;
+
+ case MATCH_NO:
+ break;
+
+ case MATCH_ERROR:
+ return MATCH_ERROR;
+ }
+
+ next_item:
+ if (gfc_match_eos () == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in IMPORT statement at %C");
+ return MATCH_ERROR;
+}
+
/* Matches an attribute specification including array specs. If
successful, leaves the variables current_attr and current_as
holding the specification. Also sets the colon_seen variable for
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 118545)
+++ gcc/fortran/gfortran.h (working copy)
@@ -222,7 +222,7 @@
ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO,
- ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_INQUIRE, ST_INTERFACE,
+ ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT, ST_INQUIRE, ST_INTERFACE,
ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE,
@@ -1008,6 +1008,9 @@
/* Set to 1 if namespace is a BLOCK DATA program unit. */
int is_block_data;
+
+ /* Set to 1 if namespace is an interface body with "IMPORT" used */
+ int has_import_set;
}
gfc_namespace;
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h (revision 118545)
+++ gcc/fortran/match.h (working copy)
@@ -136,6 +136,7 @@
match gfc_match_allocatable (void);
match gfc_match_dimension (void);
match gfc_match_external (void);
+match gfc_match_import (void);
match gfc_match_intent (void);
match gfc_match_intrinsic (void);
match gfc_match_optional (void);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 118545)
+++ gcc/fortran/parse.c (working copy)
@@ -229,6 +229,7 @@
match ("inquire", gfc_match_inquire, ST_INQUIRE);
match ("implicit", gfc_match_implicit, ST_IMPLICIT);
match ("implicit% none", gfc_match_implicit_none, ST_IMPLICIT_NONE);
+ match ("import", gfc_match_import, ST_IMPORT);
match ("interface", gfc_match_interface, ST_INTERFACE);
match ("intent", gfc_match_intent, ST_ATTR_DECL);
match ("intrinsic", gfc_match_intrinsic, ST_ATTR_DECL);
@@ -1038,6 +1039,9 @@
case ST_IMPLIED_ENDDO:
p = _("implied END DO");
break;
+ case ST_IMPORT:
+ p = "IMPORT";
+ break;
case ST_INQUIRE:
p = "INQUIRE";
break;
@@ -1352,7 +1356,9 @@
| program subroutine function module |
+---------------------------------------+
| use |
- |---------------------------------------+
+ +---------------------------------------+
+ | import |
+ +---------------------------------------+
| | implicit none |
| +-----------+------------------+
| | parameter | implicit |
@@ -1376,8 +1382,8 @@
typedef struct
{
enum
- { ORDER_START, ORDER_USE, ORDER_IMPLICIT_NONE, ORDER_IMPLICIT,
- ORDER_SPEC, ORDER_EXEC
+ { ORDER_START, ORDER_USE, ORDER_IMPORT, ORDER_IMPLICIT_NONE,
+ ORDER_IMPLICIT, ORDER_SPEC, ORDER_EXEC
}
state;
gfc_statement last_statement;
@@ -1401,6 +1407,12 @@
p->state = ORDER_USE;
break;
+ case ST_IMPORT:
+ if (p->state > ORDER_IMPORT)
+ goto order;
+ p->state = ORDER_IMPORT;
+ break;
+
case ST_IMPLICIT_NONE:
if (p->state > ORDER_IMPLICIT_NONE)
goto order;
@@ -1820,6 +1832,7 @@
/* Fall through */
case ST_USE:
+ case ST_IMPORT:
case ST_IMPLICIT_NONE:
case ST_IMPLICIT:
case ST_PARAMETER:
--- /dev/null 2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/import.f90 2006-11-07 23:44:46.000000000 +0100
@@ -0,0 +1,56 @@
+! { dg-do run }
+! Test whether import works
+! PR fortran/29601
+
+subroutine test(x)
+ type myType3
+ sequence
+ integer :: i
+ end type myType3
+ type(myType3) :: x
+ if(x%i /= 7) call abort()
+ x%i = 1
+end subroutine test
+
+
+subroutine bar(x)
+ type myType
+ sequence
+ integer :: i
+ end type myType
+ type(myType) :: x
+ if(x%i /= 2) call abort()
+ x%i = 5
+end subroutine bar
+
+
+program foo
+ type myType
+ sequence
+ integer :: i
+ end type myType
+ type myType3
+ sequence
+ integer :: i
+ end type myType3
+ interface
+ subroutine bar(x)
+ import
+ type(myType) :: x
+ end subroutine bar
+ subroutine test(x)
+ import :: myType3
+ import myType3 ! { dg-warning "already IMPORTed from" }
+ type(myType3) :: x
+ end subroutine test
+ end interface
+
+ type(myType) :: y
+ type(myType3) :: z
+ y%i = 2
+ call bar(y)
+ if(y%i /= 5) call abort()
+ z%i = 7
+ call test(z)
+ if(z%i /= 1) call abort()
+end program foo
--- /dev/null 2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/import2.f90 2006-11-07 23:45:44.000000000 +0100
@@ -0,0 +1,58 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! { dg-shouldfail "Fortran 2003 feature with -std=f95" }
+! Test whether import does not work with -std=f95
+! PR fortran/29601
+
+subroutine test(x)
+ type myType3
+ sequence
+ integer :: i
+ end type myType3
+ type(myType3) :: x
+ if(x%i /= 7) call abort()
+ x%i = 1
+end subroutine test
+
+
+subroutine bar(x)
+ type myType
+ sequence
+ integer :: i
+ end type myType
+ type(myType) :: x
+ if(x%i /= 2) call abort()
+ x%i = 5
+end subroutine bar
+
+
+program foo
+ type myType
+ sequence
+ integer :: i
+ end type myType
+ type myType3
+ sequence
+ integer :: i
+ end type myType3
+ interface
+ subroutine bar(x)
+ import ! { dg-error "Fortran 2003: IMPORT statement" }
+ type(myType) :: x ! { dg-error "not been declared within the interface" }
+ end subroutine bar
+ subroutine test(x)
+ import :: myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
+ import myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
+ type(myType3) :: x ! { dg-error "not been declared within the interface" }
+ end subroutine test
+ end interface
+
+ type(myType) :: y
+ type(myType3) :: z
+ y%i = 2
+ call bar(y) ! { dg-error "Type/rank mismatch in argument" }
+ if(y%i /= 5) call abort()
+ z%i = 7
+ call test(z) ! { dg-error "Type/rank mismatch in argument" }
+ if(z%i /= 1) call abort()
+end program foo
--- /dev/null 2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/import3.f90 2006-11-07 23:52:04.000000000 +0100
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-shouldfail "Invalid use of IMPORT" }
+! Test invalid uses of import
+! PR fortran/29601
+
+subroutine test()
+ type myType3
+ import ! { dg-error "only permitted in an INTERFACE body" }
+ sequence
+ integer :: i
+ end type myType3
+end subroutine test
+
+program foo
+ import ! { dg-error "only permitted in an INTERFACE body" }
+ type myType
+ sequence
+ integer :: i
+ end type myType
+ type myType3
+ sequence
+ integer :: i
+ end type myType3
+ interface
+ import ! { dg-error "only permitted in an INTERFACE body" }
+ subroutine bar()
+ import foob ! { dg-error "Can not IMPORT 'foob' from host scoping unit" }
+ end subroutine bar
+ subroutine test()
+ import :: ! { dg-error "Expecting list of named entities" }
+ end subroutine test
+ end interface
+end program foo
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi (Revision 118579)
+++ gcc/fortran/gfortran.texi (Arbeitskopie)
@@ -1387,7 +1387,12 @@
@cindex @code{VOLATILE}
The @code{VOLATILE} statement and attribute.
+@item
+@cindex @code{IMPORT}
+The @code{IMPORT} statement, allowing to import
+host-associated derived types.
+
@end itemize