Bug 50225 - [OOP] The allocation status for polymorphic allocatable function results is not set properly
Summary: [OOP] The allocation status for polymorphic allocatable function results is n...
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.3.2
: P3 normal
Target Milestone: ---
Assignee: janus
URL:
Keywords: wrong-code
Depends on:
Blocks:
 
Reported: 2011-08-29 13:43 UTC by Arjen Markus
Modified: 2011-08-29 21:57 UTC (History)
2 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2011-08-29 00:00:00


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Arjen Markus 2011-08-29 13:43:57 UTC
If you compile the program below with "-fcheck=all", it fails, claiming that 
the result variable in the function add_vector() is already allocated. The 
error disappears when you change "class(point2d)" to "type(point2d)".

(In a more elaborate version of the program, it also fails without this option
and with this option there is a segmentation fault.)

module points2d3d

  implicit none

  type point2d
      real :: x, y

  end type

contains

 subroutine print( point )

   class(point2d) :: point
   write(*,'(2f10.4)') point%x, point%y
 end subroutine


 subroutine random_vector( point )

   class(point2d) :: point
   call random_number( point%x )
   call random_number( point%y )
   point%x = 2.0 * (point%x - 0.5)
   point%y = 2.0 * (point%y - 0.5)
 end subroutine


 function add_vector( point, vector )

   class(point2d), intent(in)  :: point, vector
   class(point2d), allocatable :: add_vector

   allocate( add_vector )
   add_vector%x = point%x + vector%x
   add_vector%y = point%y + vector%y
 end function


end module points2d3d


program random_walk

 use points2d3d


 type(point2d), target   :: point_2d, vector_2d
 class(point2d), pointer :: point, vector
 integer :: i


 point  => point_2d
 vector => vector_2d
 write(*,*) 'Two-dimensional walk:'


 do i=1,10
   call random_vector(point)
   call random_vector(vector)
   call print(add_vector(point, vector))
 end do

end program random_walk
Comment 1 Dominique d'Humieres 2011-08-29 13:49:48 UTC
On x86_64-apple-darwin10 I don't need the option -fcheck=all to get the run-timr error. However the error goes away with any optimization above -O1 (at least all those I have tried;-). This is also true for the original code posted at http://gcc.gnu.org/ml/fortran/2011-08/msg00239.html which gives

 Two-dimensional walk:
    1.0883    0.1832
    1.0618    0.1794
    0.9765    0.0804
    0.9459    0.0489
    0.8895   -0.0245
    0.9696   -0.0471
    0.9587   -0.0147
    0.8620    0.0154
    0.8912   -0.0200
    0.9624   -0.0397
 Three-dimensional walk:
   -0.5517    0.9285    0.1628
   -0.6316    0.9795    0.1839
   -0.5878    1.0590    0.2156
   -0.6576    1.0815    0.3113
   -0.5578    1.0328    0.3215
   -0.5260    1.0436    0.4170
   -0.4456    1.0752    0.4628
   -0.4651    1.1609    0.3924
   -0.4302    1.2149    0.3602
   -0.5070    1.2377    0.4244

if compiled with -O1 or above. Note also that the executable obtained with -O1 run under valgrind without error. Apparently the "wrong part" is removed by some optimization starting at -O1.
Comment 2 Tobias Burnus 2011-08-29 14:00:45 UTC
For what it is worth: The 2D example here and the 2D and 3D examples at
http://gcc.gnu.org/ml/fortran/2011-08/msg00239.html work with PGI 11.5, the 2D example also works with Cray 7.1.4.111 but the 3D example causes an ICE.
Comment 3 janus 2011-08-29 16:31:29 UTC
Preliminary patch which seems to fix the test case:

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c    (revision 178183)
+++ gcc/fortran/trans-decl.c    (working copy)
@@ -5215,17 +5215,25 @@ gfc_generate_function_code (gfc_namespace * ns)
     {
       tree result = get_proc_result (sym);
 
-      if (result != NULL_TREE
-           && sym->attr.function
-           && !sym->attr.pointer)
+      if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
        {
          if (sym->attr.allocatable && sym->attr.dimension == 0
              && sym->result == sym)
            gfc_add_modify (&init, result, fold_convert (TREE_TYPE (result),
                                                         null_pointer_node));
+         else if (sym->ts.type == BT_CLASS
+                  && CLASS_DATA (sym)->attr.allocatable
+                  && sym->attr.dimension == 0 && sym->result == sym)
+           {
+             tmp = CLASS_DATA (sym)->backend_decl;
+             tmp = fold_build3_loc (input_location, COMPONENT_REF,
+                                    TREE_TYPE (tmp), result, tmp, NULL_TREE);
+             gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
+                                                       null_pointer_node));
+           }
          else if (sym->ts.type == BT_DERIVED
-             && sym->ts.u.derived->attr.alloc_comp
-             && !sym->attr.allocatable)
+                  && sym->ts.u.derived->attr.alloc_comp
+                  && !sym->attr.allocatable)
            {
              rank = sym->as ? sym->as->rank : 0;
              tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
Comment 4 janus 2011-08-29 21:55:16 UTC
Author: janus
Date: Mon Aug 29 21:55:10 2011
New Revision: 178262

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=178262
Log:
2011-08-29  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/50225
	* trans-decl.c (gfc_generate_function_code): Nullify polymorphic
	allocatable function results.

2011-08-29  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/50225
	* gfortran.dg/class_result_1.f03: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/class_result_1.f03
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/trans-decl.c
    trunk/gcc/testsuite/ChangeLog
Comment 5 janus 2011-08-29 21:57:33 UTC
Fixed with r178262. Closing.

Thanks for the report, Arjen!