| Summary: | [OOP] SELECT TYPE fails to execute correct TYPE IS block | ||
|---|---|---|---|
| Product: | gcc | Reporter: | Andrew Benson <abensonca> |
| Component: | fortran | Assignee: | janus |
| Status: | RESOLVED FIXED | ||
| Severity: | normal | CC: | abensonca, janus |
| Priority: | P3 | Keywords: | wrong-code |
| Version: | 4.6.0 | ||
| Target Milestone: | 4.6.0 | ||
| Host: | Target: | ||
| Build: | Known to work: | ||
| Known to fail: | Last reconfirmed: | 2011-02-16 17:32:32 | |
| Attachments: | Test case to reproduce the bug. | ||
|
Description
Andrew Benson
2011-02-16 17:18:47 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
contains
procedure :: walk
end type
contains
subroutine walk (thisNode)
class (treeNode) :: thisNode
print *, SAME_TYPE_AS (thisNode, treeNode())
end subroutine
end module
module Merger_Trees
use Tree_Nodes
private
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!
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)
return;
- 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))
return;
This fixes the test case, but is not regtested yet.
I can confirm that this patch resolves the problem in the application from which my original test case was derived. 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 Log: 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 'check_access'. (write_dt_extensions,write_symbol0,write_generic,write_symtree): Use 'gfc_check_symbol_access'. (write_operator,write_module): Renamed 'gfc_check_access'. * resolve.c (resolve_fl_procedure,resolve_fl_derived, resolve_fl_namelist,resolve_symbol,resolve_fntype): Use 'gfc_check_symbol_access'. 2011-02-18 Janus Weil <janus@gcc.gnu.org> PR fortran/47767 * gfortran.dg/class_40.f03: New. Added: trunk/gcc/testsuite/gfortran.dg/class_40.f03 Modified: trunk/gcc/fortran/ChangeLog trunk/gcc/fortran/gfortran.h trunk/gcc/fortran/module.c trunk/gcc/fortran/resolve.c trunk/gcc/testsuite/ChangeLog |