Patchwork [Fortran] PR fortran/45783 and PR fortran/45795: Fix ICE in gfc_add_component_ref

login
register
mail settings
Submitter Daniel Kraft
Date Sept. 26, 2010, 6:42 p.m.
Message ID <4C9F9403.2080906@domob.eu>
Download mbox | patch
Permalink /patch/65798/
State New
Headers show

Comments

Jerry DeLisle - Sept. 26, 2010, 6:42 p.m.
On 09/26/2010 11:42 AM, Daniel Kraft wrote:
> Hi,
>
> this trivial patch fixes the two PRs about ICE in gfc_add_component_ref. I only
> added the test-case from PR 45795, but I think this is enough and ok. The
> problem was that my definability patch changed the order of resolution for
> SELECT TYPE vs. its contained code, and this uncovered a bug introduced when I
> changed SELECT TYPE to use ASSOCIATE logic internally. Namely, that the
> associate-name gets its target's typespec -- this is wrong for SELECT TYPE
> obviously.
>
> I will regtest now on x86_64-unknown-linux-gnu. Ok for trunk if no failures?

Ok if regression tests pass.

Jerry
Daniel Kraft - Sept. 26, 2010, 6:42 p.m.
Hi,

this trivial patch fixes the two PRs about ICE in gfc_add_component_ref. 
  I only added the test-case from PR 45795, but I think this is enough 
and ok.  The problem was that my definability patch changed the order of 
resolution for SELECT TYPE vs. its contained code, and this uncovered a 
bug introduced when I changed SELECT TYPE to use ASSOCIATE logic 
internally.  Namely, that the associate-name gets its target's typespec 
-- this is wrong for SELECT TYPE obviously.

I will regtest now on x86_64-unknown-linux-gnu.  Ok for trunk if no 
failures?

Yours,
Daniel
Daniel Kraft - Sept. 26, 2010, 7:32 p.m.
Jerry DeLisle wrote:
> On 09/26/2010 11:42 AM, Daniel Kraft wrote:
>> Hi,
>>
>> this trivial patch fixes the two PRs about ICE in 
>> gfc_add_component_ref. I only
>> added the test-case from PR 45795, but I think this is enough and ok. The
>> problem was that my definability patch changed the order of resolution 
>> for
>> SELECT TYPE vs. its contained code, and this uncovered a bug 
>> introduced when I
>> changed SELECT TYPE to use ASSOCIATE logic internally. Namely, that the
>> associate-name gets its target's typespec -- this is wrong for SELECT 
>> TYPE
>> obviously.
>>
>> I will regtest now on x86_64-unknown-linux-gnu. Ok for trunk if no 
>> failures?
> 
> Ok if regression tests pass.

No failures.

Committed revision 164638.

Thanks for the review!

Daniel

Patch

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 164634)
+++ gcc/fortran/resolve.c	(working copy)
@@ -7570,7 +7570,11 @@  resolve_assoc_var (gfc_symbol* sym, bool
       sym->attr.target = (tsym->attr.target || tsym->attr.pointer);
     }
 
-  sym->ts = target->ts;
+  /* Get type if this was not already set.  Note that it can be
+     some other type than the target in case this is a SELECT TYPE
+     selector!  So we must not update when the type is already there.  */
+  if (sym->ts.type == BT_UNKNOWN)
+    sym->ts = target->ts;
   gcc_assert (sym->ts.type != BT_UNKNOWN);
 
   /* See if this is a valid association-to-variable.  */
@@ -7673,8 +7677,8 @@  resolve_select_type (gfc_code *code, gfc
 	      error++;
 	      continue;
 	    }
-	  else
-	    default_case = body;
+
+	  default_case = body;
 	}
     }
     
Index: gcc/testsuite/gfortran.dg/select_type_18.f03
===================================================================
--- gcc/testsuite/gfortran.dg/select_type_18.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/select_type_18.f03	(revision 0)
@@ -0,0 +1,90 @@ 
+! { dg-do compile }
+
+! PR fortran/45783
+! PR fortran/45795
+! This used to fail because of incorrect compile-time typespec on the
+! SELECT TYPE selector.
+
+! This is the test-case from PR 45795.
+! Contributed by Salvatore Filippone, sfilippone@uniroma2.it.
+
+module base_mod
+  
+  type  :: base
+    integer     :: m, n
+  end type base
+
+end module base_mod
+
+module s_base_mod
+  
+  use base_mod
+
+  type, extends(base) :: s_base
+  contains
+    procedure, pass(a) :: cp_to_foo   => s_base_cp_to_foo   
+    
+  end type s_base
+  
+  
+  type, extends(s_base) :: s_foo
+    
+    integer              :: nnz
+    integer, allocatable :: ia(:), ja(:)
+    real, allocatable :: val(:)
+    
+  contains
+    
+    procedure, pass(a) :: cp_to_foo    => s_cp_foo_to_foo
+    
+  end type s_foo
+  
+  
+  interface 
+    subroutine s_base_cp_to_foo(a,b,info) 
+      import :: s_base, s_foo
+      class(s_base), intent(in) :: a
+      class(s_foo), intent(inout) :: b
+      integer, intent(out)            :: info
+    end subroutine s_base_cp_to_foo
+  end interface
+  
+  interface 
+    subroutine s_cp_foo_to_foo(a,b,info) 
+      import :: s_foo
+      class(s_foo), intent(in) :: a
+      class(s_foo), intent(inout) :: b
+      integer, intent(out)            :: info
+    end subroutine s_cp_foo_to_foo
+  end interface
+
+end module s_base_mod
+
+
+subroutine trans2(a,b)
+  use s_base_mod
+  implicit none 
+
+  class(s_base), intent(out) :: a
+  class(base), intent(in)   :: b
+
+  type(s_foo) :: tmp
+  integer err_act, info
+
+
+  info = 0
+  select type(b)
+  class is (s_base)
+    call b%cp_to_foo(tmp,info)
+  class default
+    info = -1
+    write(*,*) 'Invalid dynamic type'
+  end select
+  
+  if (info /= 0) write(*,*) 'Error code ',info
+
+  return
+
+end subroutine trans2
+
+! { dg-final { cleanup-modules "base_mod s_base_mod" } }