From d67fc9aee64e74ce9298311bfd63810185722f1c Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 15 Nov 2006 15:46:42 +0000 Subject: [PATCH] fortran/ 2006-11-15 Tobias Burnus 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 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 --- gcc/fortran/ChangeLog | 14 ++++++ gcc/fortran/decl.c | 95 ++++++++++++++++++++++++++++++++++- gcc/fortran/gfortran.h | 5 +- gcc/fortran/gfortran.texi | 5 ++ gcc/fortran/match.h | 1 + gcc/fortran/parse.c | 19 +++++-- gcc/testsuite/ChangeLog | 7 +++ gcc/testsuite/gfortran.dg/import.f90 | 56 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/import2.f90 | 58 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/import3.f90 | 33 ++++++++++++ 10 files changed, 287 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/import.f90 create mode 100644 gcc/testsuite/gfortran.dg/import2.f90 create mode 100644 gcc/testsuite/gfortran.dg/import3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ea2d741..b91b64b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,4 +1,18 @@ 2006-11-15 Tobias Burnus + + 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 Francois-Xavier Coudert PR fortran/27588 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 6c5cfcc..ae4271c 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 dbba22e..e5d32f6 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 d97785b..023ed80 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 db4f1b8..8a8ab99 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 9d85516..cff00d5 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: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c485ed6..00b4096 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,12 @@ 2006-11-15 Tobias Burnus + 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 + PR fortran/27588 * gfortran.dg/char_bounds_check_fail_1.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/import.f90 b/gcc/testsuite/gfortran.dg/import.f90 new file mode 100644 index 0000000..5d2b714 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/import.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/import2.f90 b/gcc/testsuite/gfortran.dg/import2.f90 new file mode 100644 index 0000000..340bc51 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/import2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/import3.f90 b/gcc/testsuite/gfortran.dg/import3.f90 new file mode 100644 index 0000000..911c0c8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/import3.f90 @@ -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 -- 2.7.4