Bug 47767 - [OOP] SELECT TYPE fails to execute correct TYPE IS block
Summary: [OOP] SELECT TYPE fails to execute correct TYPE IS block
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.6.0
: P3 normal
Target Milestone: ---
Assignee: janus
Keywords: wrong-code
Depends on:
Reported: 2011-02-16 17:18 UTC by Andrew Benson
Modified: 2011-02-18 10:07 UTC (History)
2 users (show)

See Also:
Known to work:
Known to fail:
Last reconfirmed: 2011-02-16 17:32:32

Test case to reproduce the bug. (284 bytes, text/plain)
2011-02-16 17:18 UTC, Andrew Benson

Note You need to log in before you can comment on or make changes to this bug.
Description Andrew Benson 2011-02-16 17:18:47 UTC
Created attachment 23363 [details]
Test case to reproduce the bug.

The attached code should execute the contents of the TYPE IS block and print "correct", but fails to do so, falling through to the CLASS DEFAULT block and printing "incorrect".

There are a number of ways to avoid the bug and get the output 'correct':

* removing the 'private' statement
* removing the 'public' statement
* removing the 'baseNode' component
* removing the unneeded module 'merger_tree_build'

Compiled using r170207 of gfortran 4.6.0

$ gfortran selectTypeFail.F90  -o selectTypeFail.exe -g -fbacktrace -v
Driving: gfortran selectTypeFail.F90 -o selectTypeFail.exe -g -fbacktrace -v -l gfortran -l m -shared-libgcc
Using built-in specs.
Target: i686-pc-linux-gnu
Configured with: ../gcc-4.6/configure --prefix=/usr/local/gcc-trunk --enable-languages=c,c++,fortran --disable-multilib --with-gmp=/usr/local --with-mpc=/usr/local --with-mpfr=/usr/local
Thread model: posix
gcc version 4.6.0 20110216 (experimental) (GCC) 
COLLECT_GCC_OPTIONS='-o' 'selectTypeFail.exe' '-g' '-fbacktrace' '-v' '-shared-libgcc' '-mtune=generic' '-march=pentiumpro'
 /usr/local/gcc-trunk/libexec/gcc/i686-pc-linux-gnu/4.6.0/f951 selectTypeFail.F90 -cpp=/tmp/ccro8Gvw.f90 -quiet -v selectTypeFail.F90 -quiet -dumpbase selectTypeFail.F90 -mtune=generic -march=pentiumpro -auxbase selectTypeFail -g -version -fbacktrace -fintrinsic-modules-path /usr/local/gcc-trunk/lib/gcc/i686-pc-linux-gnu/4.6.0/finclude -o /tmp/ccguPzRS.s
GNU Fortran (GCC) version 4.6.0 20110216 (experimental) (i686-pc-linux-gnu)
        compiled by GNU C version 4.6.0 20110216 (experimental), GMP version 4.3.2, MPFR version 3.0.0, MPC version 0.8.2
GGC heuristics: --param ggc-min-expand=30 --param ggc-min-heapsize=4096
ignoring nonexistent directory "/usr/local/gcc-trunk/lib/gcc/i686-pc-linux-gnu/4.6.0/../../../../i686-pc-linux-gnu/include"
#include "..." search starts here:
#include <...> search starts here:
End of search list.
GNU Fortran (GCC) version 4.6.0 20110216 (experimental) (i686-pc-linux-gnu)
        compiled by GNU C version 4.6.0 20110216 (experimental), GMP version 4.3.2, MPFR version 3.0.0, MPC version 0.8.2
GGC heuristics: --param ggc-min-expand=30 --param ggc-min-heapsize=4096
COLLECT_GCC_OPTIONS='-o' 'selectTypeFail.exe' '-g' '-fbacktrace' '-v' '-shared-libgcc' '-mtune=generic' '-march=pentiumpro'
 as --32 -o /tmp/ccZqndJg.o /tmp/ccguPzRS.s
Reading specs from /usr/local/gcc-trunk/lib/gcc/i686-pc-linux-gnu/4.6.0/../../../libgfortran.spec
rename spec lib to liborig
COLLECT_GCC_OPTIONS='-o' 'selectTypeFail.exe' '-g' '-fbacktrace' '-v' '-shared-libgcc' '-mtune=generic' '-march=pentiumpro'
COLLECT_GCC_OPTIONS='-o' 'selectTypeFail.exe' '-g' '-fbacktrace' '-v' '-shared-libgcc' '-mtune=generic' '-march=pentiumpro'
 /usr/local/gcc-trunk/libexec/gcc/i686-pc-linux-gnu/4.6.0/collect2 --eh-frame-hdr -m elf_i386 -dynamic-linker /lib/ld-linux.so.2 -o selectTypeFail.exe /usr/lib/crt1.o /usr/lib/crti.o /usr/local/gcc-trunk/lib/gcc/i686-pc-linux-gnu/4.6.0/crtbegin.o -L/usr/local/gcc-trunk/lib/gcc/i686-pc-linux-gnu/4.6.0 -L/usr/local/gcc-trunk/lib/gcc/i686-pc-linux-gnu/4.6.0/../../.. /tmp/ccZqndJg.o -lgfortran -lm -lgcc_s -lgcc -lquadmath -lm -lgcc_s -lgcc -lc -lgcc_s -lgcc /usr/local/gcc-trunk/lib/gcc/i686-pc-linux-gnu/4.6.0/crtend.o /usr/lib/crtn.o

$ selectTypeFail.exe 
Comment 1 janus 2011-02-16 18:31:06 UTC
Here is a variant: Apart from SELECT TYPE, this bug can also be exposed via the SAME_TYPE_AS intrinsic.

module Tree_Nodes
  type treeNode
     procedure :: walk
  end type
  subroutine walk (thisNode)
    class (treeNode) :: thisNode
    print *, SAME_TYPE_AS (thisNode, treeNode())
  end subroutine
end module

module Merger_Trees
  use Tree_Nodes
  public :: mergerTree
  type mergerTree
     type(treeNode), pointer :: baseNode
  end type
end module

module Merger_Tree_Build
  use Merger_Trees
end module

program test
  use Merger_Tree_Build
  use Tree_Nodes
  type(treeNode) :: node
  call walk (node)
end program

This prints "F", but should print "T".

The underlying problem seems to be related to the vtable not being properly set up. The vtab symbol for the type 'treeNode' apparently is present, but it is not initialized properly: The '_hash' component is 0!

Looking at the mod files, the symbol '__vtab_tree_nodes_Treenode' seems to be present in tree_nodes.mod and merger_tree_build.mod, but not in merger_trees.mod!
Comment 2 janus 2011-02-16 21:58:12 UTC
Ok, I think what we need to do is basically to make sure that vtab/vtype symbols are always public and are not affected by PRIVATE statements. Here is a first patch:

Index: gcc/fortran/module.c
--- gcc/fortran/module.c        (revision 170222)
+++ gcc/fortran/module.c        (working copy)
@@ -4874,7 +4874,8 @@ write_symbol0 (gfc_symtree *st)
       && !sym->attr.subroutine && !sym->attr.function)
     dont_write = true;
-  if (!gfc_check_access (sym->attr.access, sym->ns->default_access))
+  if (!sym->attr.vtab && !sym->attr.vtype
+      && !gfc_check_access (sym->attr.access, sym->ns->default_access))
     dont_write = true;
   if (!dont_write)
@@ -4982,7 +4983,8 @@ write_symtree (gfc_symtree *st)
        && sym->ns->proc_name->attr.if_source == IFSRC_IFBODY)
-  if (!gfc_check_access (sym->attr.access, sym->ns->default_access)
+  if ((!sym->attr.vtab && !sym->attr.vtype
+       && !gfc_check_access (sym->attr.access, sym->ns->default_access))
       || (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
          && !sym->attr.subroutine && !sym->attr.function))

This fixes the test case, but is not regtested yet.
Comment 3 Andrew Benson 2011-02-16 23:17:49 UTC
I can confirm that this patch resolves the problem in the application from which my original test case was derived.
Comment 4 janus 2011-02-18 10:04:33 UTC
Author: janus
Date: Fri Feb 18 10:04:30 2011
New Revision: 170269

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=170269
2011-02-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47767
	* gfortran.h (gfc_check_access): Removed prototype.
	(gfc_check_symbol_access): Added prototype.
	* module.c (gfc_check_access): Renamed to 'check_access', made static.
	(gfc_check_symbol_access): New function, basically a shortcut for
	(write_dt_extensions,write_symbol0,write_generic,write_symtree): Use
	(write_operator,write_module): Renamed 'gfc_check_access'.
	* resolve.c (resolve_fl_procedure,resolve_fl_derived,
	resolve_fl_namelist,resolve_symbol,resolve_fntype): Use

2011-02-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47767
	* gfortran.dg/class_40.f03: New.

Comment 5 janus 2011-02-18 10:07:03 UTC
Fixed with r170269. Closing.

Thanks for the report, Andrew!