1! { dg-do run } 2! 3! PR 78443: [OOP] Incorrect behavior with non_overridable keyword 4! 5! Contributed by federico <perini@wisc.edu> 6 7module types 8 implicit none 9 10 11 ! Abstract parent class and its child type 12 type, abstract :: P1 13 contains 14 procedure :: test => test1 15 procedure (square_interface), deferred :: square 16 endtype 17 18 ! Deferred procedure interface 19 abstract interface 20 function square_interface( this, x ) result( y ) 21 import P1 22 class(P1) :: this 23 real :: x, y 24 end function square_interface 25 end interface 26 27 type, extends(P1) :: C1 28 contains 29 procedure, non_overridable :: square => C1_square 30 endtype 31 32 ! Non-abstract parent class and its child type 33 type :: P2 34 contains 35 procedure :: test => test2 36 procedure :: square => P2_square 37 endtype 38 39 type, extends(P2) :: C2 40 contains 41 procedure, non_overridable :: square => C2_square 42 endtype 43 44contains 45 46 real function test1( this, x ) 47 class(P1) :: this 48 real :: x 49 test1 = this % square( x ) 50 end function 51 52 real function test2( this, x ) 53 class(P2) :: this 54 real :: x 55 test2 = this % square( x ) 56 end function 57 58 function P2_square( this, x ) result( y ) 59 class(P2) :: this 60 real :: x, y 61 y = -100. ! dummy 62 end function 63 64 function C1_square( this, x ) result( y ) 65 class(C1) :: this 66 real :: x, y 67 y = x**2 68 end function 69 70 function C2_square( this, x ) result( y ) 71 class(C2) :: this 72 real :: x, y 73 y = x**2 74 end function 75 76end module 77 78program main 79 use types 80 implicit none 81 type(P2) :: t1 82 type(C2) :: t2 83 type(C1) :: t3 84 85 if ( t1 % test( 2. ) /= -100.) STOP 1 86 if ( t2 % test( 2. ) /= 4.) STOP 2 87 if ( t3 % test( 2. ) /= 4.) STOP 3 88end program 89