[Patch, fortran] PR32827 - IMPORT fails for TYPE when also used in INTERFACE

[Patch, fortran] PR32827 - IMPORT fails for TYPE when also used in INTERFACE

[Paul Thomas]

[-- Attachment #1: Type: text/plain, Size: 1192 bytes --]

:ADDPATCH fortran:

This problem comes about when a symbol is imported by name and then 
referred to in its own namespace.  This happens because the namespace of 
the imported symbol is changed to that of the interface.

The patch works by removing this change of interface and by adding an 
'imported' symbol attribute.  The check for an imported symbol is done 
by looking for the symtree in the interface namespace and testing for 
the imported attribute.  gfc_get_sym_tree has to be modified not to give 
an error on imported symbols.  The testcase is based on the reporter's.

Regtested on amd64/Cygwin_NT - OK for trunk?

Paul

2007-08-12  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/32827
    * decl.c (variable_decl): Check for an imported symbol
    by looking for its symtree and testing for the imported
    attribute.
    (gfc_match_import): Remove change of symbol's namespace
    and set the attribute imported instead.
    * symbol.c (gfc_get_sym_tree): It is not an error if a
    symbol is imported.
    * gfortran.h : Add the 'imported' to symbol_attribute.

2007-08-12  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/32827
    * gfortran.dg/import6.f90: New test.



[-- Attachment #2: pr32827.diff --]
[-- Type: text/x-patch, Size: 4685 bytes --]

Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c	(revision 127213)
--- gcc/fortran/decl.c	(working copy)
*************** variable_decl (int elem)
*** 1553,1565 ****
    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
!       && !gfc_current_ns->has_import_set)
      {
!       gfc_error ("the type of '%s' at %C has not been declared within the "
! 		 "interface", name);
!       m = MATCH_ERROR;
!       goto cleanup;
      }
  
    /* In functions that have a RESULT variable defined, the function
--- 1553,1572 ----
    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)
      {
!       gfc_symtree *st;
!       st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.derived->name);
!       if (!(current_ts.derived->attr.imported
! 		&& st != NULL
! 		&& st->n.sym == current_ts.derived)
! 	    && !gfc_current_ns->has_import_set)
! 	{
! 	    gfc_error ("the type of '%s' at %C has not been declared within the "
! 		       "interface", name);
! 	    m = MATCH_ERROR;
! 	    goto cleanup;
! 	}
      }
  
    /* In functions that have a RESULT variable defined, the function
*************** gfc_match_import (void)
*** 2433,2439 ****
  	  st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
  	  st->n.sym = sym;
  	  sym->refs++;
! 	  sym->ns = gfc_current_ns;
  
  	  goto next_item;
  
--- 2440,2446 ----
  	  st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
  	  st->n.sym = sym;
  	  sym->refs++;
! 	  sym->attr.imported = 1;
  
  	  goto next_item;
  
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c	(revision 127213)
--- gcc/fortran/symbol.c	(working copy)
*************** gfc_get_sym_tree (const char *name, gfc_
*** 2393,2399 ****
  
        p = st->n.sym;
  
!       if (p->ns != ns && (!p->attr.function || ns->proc_name != p))
  	{
  	  /* Symbol is from another namespace.  */
  	  gfc_error ("Symbol '%s' at %C has already been host associated",
--- 2393,2402 ----
  
        p = st->n.sym;
  
!       if (p->ns != ns && (!p->attr.function || ns->proc_name != p)
! 	    && !(ns->proc_name
! 		   && ns->proc_name->attr.if_source == IFSRC_IFBODY
! 		   && (ns->has_import_set || p->attr.imported)))
  	{
  	  /* Symbol is from another namespace.  */
  	  gfc_error ("Symbol '%s' at %C has already been host associated",
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 127213)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct
*** 639,645 ****
    unsigned data:1,		/* Symbol is named in a DATA statement.  */
      protected:1,		/* Symbol has been marked as protected.  */
      use_assoc:1,		/* Symbol has been use-associated.  */
!     use_only:1;			/* Symbol has been use-associated, with ONLY.  */
  
    unsigned in_namelist:1, in_common:1, in_equivalence:1;
    unsigned function:1, subroutine:1, generic:1, generic_copy:1;
--- 639,646 ----
    unsigned data:1,		/* Symbol is named in a DATA statement.  */
      protected:1,		/* Symbol has been marked as protected.  */
      use_assoc:1,		/* Symbol has been use-associated.  */
!     use_only:1,			/* Symbol has been use-associated, with ONLY.  */
!     imported:1;			/* Symbol has been associated by IMPORT.  */
  
    unsigned in_namelist:1, in_common:1, in_equivalence:1;
    unsigned function:1, subroutine:1, generic:1, generic_copy:1;
Index: gcc/testsuite/gfortran.dg/transpose_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/transpose_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/transpose_1.f90	(revision 0)
***************
*** 0 ****
--- 1,27 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR32962, in which the result of TRANSPOSE, when
+ ! an actual argument of an elemental intrinsic would receive the
+ ! wrong offset.
+ !
+ ! Contributed by Wirawan Purwanto <wirawan0@gmail.com>
+ !
+   real(kind=8), allocatable :: b(:,:)
+   real(kind=8) :: a(2,2), c(2,2)
+   i = 2
+   allocate (b(i,i))
+   a(1,1) = 2
+   a(2,1) = 3
+   a(1,2) = 7
+   a(2,2) = 11
+   call foo
+   call bar
+   if (any (c .ne. b)) call abort
+ contains
+   subroutine foo
+     b = cos(transpose(a))
+   end subroutine
+   subroutine bar
+     c = transpose(a)
+     c = cos(c)
+   end subroutine
+ end program

Re: [Patch, fortran] PR32827 - IMPORT fails for TYPE when also used in INTERFACE

[Paul Thomas]

Sorry - wrong testscase:

! { dg-do compile }
! Tests the fix for PR32827, in which IMPORT :: my_type put the
! symbol into the interface namespace, thereby generating an error
! when the declaration of 'x' is compiled.
!
! Contributed by Douglas Wells <sysmaint@contek.com>
!
subroutine func1(param)
  type :: my_type
    integer :: data
  end type my_type
  type(my_type) :: param
  param%data = 99
end subroutine func1

subroutine func2(param)
  type :: my_type
    integer :: data
  end type my_type
  type(my_type) :: param
  param%data = 21
end subroutine func2

  type :: my_type
    integer :: data
  end type my_type

  interface
    subroutine func1(param)
      import :: my_type
      type(my_type) :: param
    end subroutine func1
  end interface
  interface
    subroutine func2(param)
      import
      type(my_type) :: param
    end subroutine func2
  end interface

  type(my_type) :: x
  call func1(x)
  print *, x%data
  call func2(x)
  print *, x%data
end

Re: [Patch, fortran] PR32827 - IMPORT fails for TYPE when also used in INTERFACE

[Tobias Burnus]

:REVIEWMAIL:

Paul Thomas wrote:
> Regtested on amd64/Cygwin_NT - OK for trunk?

OK (with the correct testcase you posted later). I think the algorithm
is cleaner with this patch than the current "sym->ns = gfc_current_ns;"
- besides the fact that it fixes this PR. Thanks,

Tobias

Re: [Patch, fortran] PR32827 - IMPORT fails for TYPE when also used in INTERFACE

[Paul Thomas]

Hi Tobias
> OK (with the correct testcase you posted later). I think the algorithm
> is cleaner with this patch than the current "sym->ns = gfc_current_ns;"
> - besides the fact that it fixes this PR. Thanks,
>
>   
Thanks - it also allows multiple importation of the same symbol.

Paul