gcc/testsuite/gfortran.dg/class_alias.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! test for aliasing violations when converting class objects with
   5 ! different target and pointer attributes.
   6 !
   7 module test_module
   8
   9   implicit none
  10
  11   type, public :: test
  12     integer :: x
  13   end type test
  14
  15 contains
  16
  17   subroutine do_it6 (par2_t)
  18     class (test), target :: par2_t
  19     par2_t%x = par2_t%x + 1
  20   end subroutine do_it6
  21
  22   subroutine do_it5 (par1_p)
  23     class (test), pointer, intent(in) :: par1_p
  24     ! pointer -> target
  25     ! { dg-final { scan-tree-dump "par2_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par1_p" "original" } }
  26     call do_it6 (par1_p)
  27   end subroutine do_it5
  28
  29   subroutine do_it4 (par_p)
  30     class (test), pointer, intent(in) :: par_p
  31     ! pointer -> pointer
  32     ! { dg-final { scan-tree-dump-not "par1_p\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par_p" "original" } }
  33     call do_it5 (par_p)
  34   end subroutine do_it4
  35
  36   subroutine do_it3 (par1_t)
  37     class (test), target :: par1_t
  38     ! target -> pointer
  39     ! { dg-final { scan-tree-dump "par_p\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par1_t" "original" } }
  40     call do_it4 (par1_t)
  41   end subroutine do_it3
  42
  43   subroutine do_it2 (par_t)
  44     class (test), target :: par_t
  45     ! target -> target
  46     ! { dg-final { scan-tree-dump-not "par1_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par_t" "original" } }
  47     call do_it3 (par_t)
  48   end subroutine do_it2
  49
  50   subroutine do_it1 (par1_a)
  51     class (test), allocatable :: par1_a
  52     ! allocatable -> target
  53     ! { dg-final { scan-tree-dump "par_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par1_a" "original" } }
  54     call do_it2 (par1_a)
  55   end subroutine do_it1
  56
  57   subroutine do_it (par_a)
  58     class (test), allocatable :: par_a
  59     ! allocatable -> allocatable
  60     ! { dg-final { scan-tree-dump-not "par1_a\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par_a" "original" } }
  61     call do_it1 (par_a)
  62   end subroutine do_it
  63
  64 end module test_module
  65
  66 use test_module
  67
  68   implicit none
  69   class (test), allocatable :: var_a
  70   class (test), pointer :: var_p
  71
  72
  73   allocate (var_a)
  74   allocate (var_p)
  75   var_a%x = 0
  76   var_p%x = 0
  77
  78   ! allocatable -> allocatable
  79   ! { dg-final { scan-tree-dump-not "par_a\[^\n]*VIEW_CONVERT_EXPR\[^\n]*var_a" "original" } }
  80   call do_it (var_a)
  81   ! allocatable -> target
  82   ! { dg-final { scan-tree-dump "par_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*var_a" "original" } }
  83   call do_it2 (var_a)
  84   ! pointer -> target
  85   ! { dg-final { scan-tree-dump "par_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*var_p" "original" } }
  86   call do_it2 (var_p)
  87   ! pointer -> pointer
  88   ! { dg-final { scan-tree-dump-not "par_p\[^\n]*VIEW_CONVERT_EXPR\[^\n]*var_p" "original" } }
  89   call do_it4 (var_p)
  90   if (var_a%x .ne. 2) STOP 1
  91   if (var_p%x .ne. 2) STOP 2
  92   deallocate (var_a)
  93   deallocate (var_p)
  94 end