2006-11-15 Tobias Burnus <burnus@net-b.de>
PR fortran/27546
* decl.c (gfc_match_import,variable_decl):
Add IMPORT support.
(gfc_match_kind_spec): Fix typo in gfc_error.
* 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/
2006-11-15 Tobias Burnus <burnus@net-b.de>
PR fortran/27546
* gfortran.dg/import.f90: New test.
* gfortran.dg/import2.f90: New test.
* gfortran.dg/import3.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118857
138bc75d-0d04-0410-961f-
82ee72b054a4
2006-11-15 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/27546
+ * decl.c (gfc_match_import,variable_decl):
+ Add IMPORT support.
+ (gfc_match_kind_spec): Fix typo in gfc_error.
+ * 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.
+
+2006-11-15 Tobias Burnus <burnus@net-b.de>
Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/27588
if (current_ts.type == BT_DERIVED
&& gfc_current_ns->proc_name
&& 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);
if (gfc_match_char (')') != MATCH_YES)
{
- gfc_error ("Missing right paren at %C");
+ gfc_error ("Missing right parenthesis at %C");
goto no_match;
}
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 ("Cannot 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
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,
/* 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;
@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
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);
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);
case ST_IMPLIED_ENDDO:
p = _("implied END DO");
break;
+ case ST_IMPORT:
+ p = "IMPORT";
+ break;
case ST_INQUIRE:
p = "INQUIRE";
break;
| program subroutine function module |
+---------------------------------------+
| use |
- |---------------------------------------+
+ +---------------------------------------+
+ | import |
+ +---------------------------------------+
| | implicit none |
| +-----------+------------------+
| | parameter | implicit |
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;
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;
/* Fall through */
case ST_USE:
+ case ST_IMPORT:
case ST_IMPLICIT_NONE:
case ST_IMPLICIT:
case ST_PARAMETER:
2006-11-15 Tobias Burnus <burnus@net-b.de>
+ PR fortran/27546
+ * gfortran.dg/import.f90: New test.
+ * gfortran.dg/import2.f90: New test.
+ * gfortran.dg/import3.f90: New test.
+
+2006-11-15 Tobias Burnus <burnus@net-b.de>
+
PR fortran/27588
* gfortran.dg/char_bounds_check_fail_1.f90: New test.
--- /dev/null
+! { 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
+! { 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
+! { 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
OSDN Git Service
