re PR fortran/45783 (ICE in gfc_add_component_ref, at fortran/class.c:77)

2010-09-26  Daniel Kraft  <d@domob.eu>

	PR fortran/45783
	PR fortran/45795
	* resolve.c (resolve_select_type): Clarify code.
	(resolve_assoc_var): Only set typespec if it is currently unknown.

2010-09-26  Daniel Kraft  <d@domob.eu>

	PR fortran/45783
	PR fortran/45795
	* gfortran.dg/select_type_18.f03: New test.

From-SVN: r164638

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 33afd97171d7b4317ec867ccfe206b0eb85448d7..f6655005cab8fae19662313ce96a329fafe64527 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2010-09-26  Daniel Kraft  <d@domob.eu>
+
+       PR fortran/45783
+       PR fortran/45795
+       * resolve.c (resolve_select_type): Clarify code.
+       (resolve_assoc_var): Only set typespec if it is currently unknown.
+
 2010-09-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/45793

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0dce3f86b180d12c2c5f0ea86de5495a840d2063..6b5bbfa742a6fc2c963ab1e8af972b69690b651f 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7570,7 +7570,11 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
       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_namespace *old_ns)
              error++;
              continue;
            }
-         else
-           default_case = body;
+
+         default_case = body;
        }
     }
     

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d9853727d4fe51bcb1f3ec2b17e9f7da0012067f..536003f3718f40d86a998ac7ce24db066161fb86 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-09-26  Daniel Kraft  <d@domob.eu>
+
+       PR fortran/45783
+       PR fortran/45795
+       * gfortran.dg/select_type_18.f03: New test.
+
 2010-09-25  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/return2.ad[sb]: New test.

diff --git a/gcc/testsuite/gfortran.dg/select_type_18.f03 b/gcc/testsuite/gfortran.dg/select_type_18.f03
new file mode 100644 (file)
index 0000000..e4bacd3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_18.f03
@@ -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" } }