OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/27546 (IMPORT is broken)

Browse Source 
fortran/
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.

From-SVN: r118857
This commit is contained in:
Tobias Burnus 2006-11-15 16:46:42 +01:00 committed by Tobias Burnus
parent dd5f63f83e
commit 8998be2031
10 changed files with 287 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,17 @@
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>

95
gcc/fortran/decl.c
View File

@ -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

5
gcc/fortran/gfortran.h
View File

@ -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;

5
gcc/fortran/gfortran.texi
View File

@ -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

1
gcc/fortran/match.h
View File

@ -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);

19
gcc/fortran/parse.c
View File

@ -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:

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
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

56
gcc/testsuite/gfortran.dg/import.f90 Normal file
View File

@ -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

58
gcc/testsuite/gfortran.dg/import2.f90 Normal file
View File

@ -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

33
gcc/testsuite/gfortran.dg/import3.f90 Normal file
View File

@ -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