summaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog14
-rw-r--r--gcc/fortran/decl.c95
-rw-r--r--gcc/fortran/gfortran.h5
-rw-r--r--gcc/fortran/gfortran.texi5
-rw-r--r--gcc/fortran/match.h1
-rw-r--r--gcc/fortran/parse.c19
6 files changed, 133 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ea2d741981e..b91b64b9f7d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,18 @@
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
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6c5cfcc411e..ae4271c9cc2 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1220,7 +1220,8 @@ variable_decl (int elem)
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);
@@ -1483,7 +1484,7 @@ gfc_match_kind_spec (gfc_typespec * ts)
if (gfc_match_char (')') != MATCH_YES)
{
- gfc_error ("Missing right paren at %C");
+ gfc_error ("Missing right parenthesis at %C");
goto no_match;
}
@@ -2005,6 +2006,96 @@ error:
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
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index dbba22e2407..e5d32f6a6ee 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -221,7 +221,7 @@ typedef enum
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,
@@ -1007,6 +1007,9 @@ typedef struct gfc_namespace
/* 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;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index d97785b16b5..023ed80819d 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1387,6 +1387,11 @@ Namelist input/output for internal files.
@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
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index db4f1b852e1..8a8ab99d437 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -136,6 +136,7 @@ void gfc_set_constant_character_len (int, gfc_expr *);
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);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 9d855164666..cff00d5c0c3 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -229,6 +229,7 @@ decode_statement (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);
@@ -1038,6 +1039,9 @@ gfc_ascii_statement (gfc_statement st)
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 @@ unexpected_statement (gfc_statement st)
| program subroutine function module |
+---------------------------------------+
| use |
- |---------------------------------------+
+ +---------------------------------------+
+ | import |
+ +---------------------------------------+
| | implicit none |
| +-----------+------------------+
| | parameter | implicit |
@@ -1376,8 +1382,8 @@ unexpected_statement (gfc_statement st)
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 @@ verify_st_order (st_state * p, gfc_statement st)
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 @@ loop:
/* Fall through */
case ST_USE:
+ case ST_IMPORT:
case ST_IMPLICIT_NONE:
case ST_IMPLICIT:
case ST_PARAMETER:
View Lorry Controller Status