gcc/testsuite/gfortran.dg/typebound_override_1.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
   4 !
   5 ! Original test case contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
   6
   7 module m
   8
   9   implicit none
  10
  11   type :: t1
  12    contains
  13      procedure, nopass :: a => a1
  14      procedure, nopass :: b => b1
  15      procedure, nopass :: c => c1
  16      procedure, nopass :: d => d1
  17      procedure, nopass :: e => e1
  18   end type
  19
  20   type, extends(t1) :: t2
  21    contains
  22      procedure, nopass :: a => a2  ! { dg-error "Character length mismatch in function result" }
  23      procedure, nopass :: b => b2  ! { dg-error "Rank mismatch in function result" }
  24      procedure, nopass :: c => c2  ! FIXME: dg-warning "Possible character length mismatch"
  25      procedure, nopass :: d => d2  ! valid, check for commutativity (+,*)
  26      procedure, nopass :: e => e2  ! { dg-error "Character length mismatch in function result" }
  27   end type
  28
  29 contains
  30
  31   function a1 ()
  32     character(len=6) :: a1
  33   end function
  34
  35   function a2 ()
  36     character(len=7) :: a2
  37   end function
  38
  39   function b1 ()
  40     integer :: b1
  41   end function
  42
  43   function b2 ()
  44     integer, dimension(2) :: b2
  45   end function
  46
  47   function c1 (x)
  48     integer, intent(in) :: x
  49     character(2*x) :: c1
  50   end function
  51
  52   function c2 (x)
  53     integer, intent(in) :: x
  54     character(3*x) :: c2
  55   end function
  56
  57   function d1 (y)
  58     integer, intent(in) :: y
  59     character(2*y+1) :: d1
  60   end function
  61
  62   function d2 (y)
  63     integer, intent(in) :: y
  64     character(1+y*2) :: d2
  65   end function
  66
  67   function e1 (z)
  68     integer, intent(in) :: z
  69     character(3) :: e1
  70   end function
  71
  72   function e2 (z)
  73     integer, intent(in) :: z
  74     character(z) :: e2
  75   end function
  76
  77 end module m
  78
  79
  80
  81
  82 module w1
  83
  84  implicit none
  85
  86  integer :: n = 1
  87
  88  type :: tt1
  89  contains
  90    procedure, nopass :: aa => aa1
  91  end type
  92
  93 contains
  94
  95  function aa1 (m)
  96   integer, intent(in) :: m
  97   character(n+m) :: aa1
  98  end function
  99
 100 end module w1
 101
 102
 103 module w2
 104
 105  use w1, only : tt1
 106
 107  implicit none
 108
 109  integer :: n = 2
 110
 111  type, extends(tt1) :: tt2
 112  contains
 113    procedure, nopass :: aa => aa2  ! FIXME: dg-warning "Possible character length mismatch"
 114  end type
 115
 116 contains
 117
 118  function aa2 (m)
 119   integer, intent(in) :: m
 120   character(n+m) :: aa2
 121  end function
 122
 123 end module w2