This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Fortran,patch] Add IMPORT support (PR27546)


:ADDPATCH fortran:

The following patch implements the IMPORT statement of Fortran 2003,
which can be used to access derived types via host association:

...
type coordType
  sequence
  real :: x, y
end coordType

interface
   function hypot(coord)
      import :: coordType ! or simply "import"
      type(coordType) :: coord
   end function hypot
end interface

(Of cause, if hypot is written in Fortran, one should use a module.)

Bootstrapped and regression tested (check-gfortran only) on
x86_64-unknown-linux-gnu (openSUSE 10.2beta2).

Tobias
fortran/
2007-11-08  Tobias Burnus  <burnus@net-b.de>

	PR fortran/27546
	* decl.c (gfc_match_import,variable_decl):
	  Add IMPORT support.
	* 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/
2007-11-08  Tobias Burnus  <burnus@net-b.de>

	PR fortran/27546
	* gfortran.dg/import.f90: Add.
	* gfortran.dg/import2.f90: Add.
	* gfortran.dg/import3.f90: Add.

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 118545)
+++ gcc/fortran/decl.c	(working copy)
@@ -1213,13 +1213,20 @@
   /* An interface body specifies all of the procedure's characteristics and these
      shall be consistent with those specified in the procedure definition, except
      that the interface may specify a procedure that is not pure if the procedure
      is defined to be pure(12.3.2).  */
   if (current_ts.type == BT_DERIVED
 	&& 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);
@@ -1482,7 +1489,7 @@
 
   if (gfc_match_char (')') != MATCH_YES)
     {
-      gfc_error ("Missing right paren at %C");
+      gfc_error ("Missing right parenthesis at %C");
       goto no_match;
     }
 
@@ -2004,7 +2011,92 @@
   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("Can not 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
    holding the specification.  Also sets the colon_seen variable for
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 118545)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -222,7 +222,7 @@
   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,
@@ -1008,6 +1008,9 @@
 
   /* 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;
 
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h	(revision 118545)
+++ gcc/fortran/match.h	(working copy)
@@ -136,6 +136,7 @@
 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);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 118545)
+++ gcc/fortran/parse.c	(working copy)
@@ -229,6 +229,7 @@
       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 @@
     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 @@
             | program  subroutine  function  module |
             +---------------------------------------+
             |                 use                   |
-            |---------------------------------------+
+            +---------------------------------------+
+            |                 import                |
+            +---------------------------------------+
             |        |        implicit none         |
             |        +-----------+------------------+
             |        | parameter |  implicit        |
@@ -1376,8 +1382,8 @@
 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 @@
       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 @@
       /* Fall through */
 
     case ST_USE:
+    case ST_IMPORT:
     case ST_IMPLICIT_NONE:
     case ST_IMPLICIT:
     case ST_PARAMETER:
--- /dev/null	2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/import.f90	2006-11-07 23:44:46.000000000 +0100
@@ -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
--- /dev/null	2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/import2.f90	2006-11-07 23:45:44.000000000 +0100
@@ -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
--- /dev/null	2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/import3.f90	2006-11-07 23:52:04.000000000 +0100
@@ -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

Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi	(Revision 118579)
+++ gcc/fortran/gfortran.texi	(Arbeitskopie)
@@ -1387,7 +1387,12 @@
 @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
 
 

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]