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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118857 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 287 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:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c485ed6b610..00b4096473c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,12 @@
 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.
 
diff --git a/gcc/testsuite/gfortran.dg/import.f90 b/gcc/testsuite/gfortran.dg/import.f90
new file mode 100644
index 00000000000..5d2b7149ae8
--- /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 00000000000..340bc519335
--- /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 00000000000..911c0c86f3c
--- /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