In the procedure binding

qiu_n_ · ‎09-05-2017

I test abstrat class and abstract interface ,ihave a problem..

how can use abstract interface ?,i have a example,i compile it ,but it can't run!

following is my code ,please correct my error,thank you !

!*------------------------------------------module employee_class ------------------*

module employee_class

type,abstract,public :: employee
private
character(len = 30) :: first_name
character(len = 30) :: last_name
character(len = 11) :: ssn
real :: pay = 0
contains
procedure,public :: set_employee =>set_employee_sub
procedure,public :: set_name =>set_name_sub
procedure,public :: set_ssn =>set_ssn_sub
procedure,public :: set_pay =>set_pay_sub
procedure,public :: get_first_name =>get_first_name_fn
procedure,public :: get_last_name =>get_last_name_fn
procedure,public :: get_ssn =>get_ssn_fn
procedure,public :: get_pay =>get_pay_fn

procedure(calc_payx),public,nopass,deferred :: calc_pay

end type employee

abstract interface
real function calc_payx(hours,rate)
implicit none
real,intent(in) :: hours
real,intent(in) :: rate

end function calc_payx

!real function calc_payy(salary)
! implicit none
! real,intent(in) :: salary
!
!
!end function calc_payy
end interface

private :: set_employee_sub,set_name_sub,set_ssn_sub,set_pay_sub
private :: get_first_name_fn,get_last_name_fn,get_ssn_fn
private :: get_pay_fn

contains
subroutine set_employee_sub(this,first,last,ssn)
implicit none
class(employee) :: this
character(len=*) ,intent(in) :: first
character(len=*) ,intent(in) :: last
character(len=*) ,intent(in) :: ssn

this%first_name = first
this%last_name = last
this%ssn = ssn
this%pay = 0

end subroutine set_employee_sub

subroutine set_name_sub(this,first,last)
implicit none
class(employee) :: this
character(len=*),intent(in) :: first
character(len=*),intent(in) :: last

this%first_name = first
this%last_name = last

end subroutine set_name_sub

subroutine set_ssn_sub(this,ssn)
implicit none
class(employee) :: this
character(len=*),intent(in) :: ssn

this%ssn = ssn

end subroutine set_ssn_sub

subroutine set_pay_sub(this,pay)
implicit none
class(employee) :: this
real,intent(in) :: pay

this%pay = pay

end subroutine set_pay_sub

character(len = 30) function get_first_name_fn(this)
implicit none
class(employee) :: this
get_first_name_fn = this%first_name
end function get_first_name_fn

character(len = 30) function get_last_name_fn(this)
implicit none
class(employee) :: this
get_last_name_fn = this%last_name
end function get_last_name_fn

character(len = 11) function get_ssn_fn(this)
implicit none
class(employee) :: this
get_ssn_fn = this%ssn
end function get_ssn_fn

real function get_pay_fn(this)
implicit none
class(employee) :: this
get_pay_fn = this%pay
end function get_pay_fn

!real function calc_pay_fn(this,hours)
! implicit none
! class(employee) :: this
! real,intent(in) :: hours
! calc_pay_fn = 0
!end function calc_pay_fn
end module employee_class
!*------------------------------------------module salaried_employee_class ------------------*
module salaried_employee_class
use employee_class
implicit none
type,public,extends(employee) :: salaried_employee
private
real :: salary = 0
contains
procedure,public :: set_salary => set_salary_sub
procedure,public,nopass:: calc_payx => calc_pay
end type salaried_employee
private :: set_salary_sub,calc_payx
contains
subroutine set_salary_sub(this,salary)
implicit none
class(salaried_employee) :: this
real,intent(in) :: salary

call this%set_pay(salary)
this%salary = salary

end subroutine set_salary_sub

real function calc_pay(hours,rate)
implicit none
!class(salaried_employee) :: this
real,intent(in) :: hours
real,intent(in) :: rate

calc_pay = hours *rate
!call this%set_pay(hours)

end function calc_pay
end module salaried_employee_class

!*------------------------------------------module hourly_employee_class ------------------*
module hourly_employee_class
use employee_class
implicit none
type,public,extends(employee) :: hourly_employee
private
real :: rate = 0
contains
procedure,public :: set_pay_rate => set_pay_rate_sub
procedure,public,nopass :: calc_payx => calc_pay
end type hourly_employee
private :: set_pay_rate_sub,calc_pay
contains
subroutine set_pay_rate_sub(this,rate)
implicit none
class(hourly_employee) :: this
real,intent(in) :: rate

this%rate = rate

end subroutine set_pay_rate_sub

real function calc_pay(hours,rate)
implicit none
!class(hourly_employee) :: this
real,intent(in) :: hours
real,intent(in) :: rate
real :: daypay

calc_pay = hours*rate*1.5

end function calc_pay

end module hourly_employee_class

program test_employee
use hourly_employee_class
use salaried_employee_class
implicit none

type(salaried_employee),pointer :: sal_emp
type(hourly_employee),pointer :: hourly_emp
integer ::istat

allocate(sal_emp,stat = istat)

call sal_emp%set_employee('john','jones','111-11-1111')
call sal_emp%set_salary(3000.0)

allocate(hourly_emp,stat = istat)
call hourly_emp%set_employee('jane','jones','222-22-2222')
call hourly_emp%set_pay_rate(12.50)

deallocate(sal_emp)
deallocate(hourly_emp)

end program

following is message for complier error :

employee.f90(33): error #6623: The procedure name of the INTERFACE block conflicts with a name in the encompassing scoping unit. [CALC_PAYX]
real function calc_payx(salary)
--------------^
employee.f90: error #8322: A deferred binding is inherited by non-abstract type; It must be overridden. [CALC_PAY]
employee.f90(191): error #7002: Error in opening the compiled module file. Check INCLUDE paths. [HOURLY_EMPLOYEE_CLASS]
use hourly_employee_class
-------^
employee.f90(192): error #7002: Error in opening the compiled module file. Check INCLUDE paths. [SALARIED_EMPLOYEE_CLASS]
use salaried_employee_class
-------^
employee.f90(195): error #6457: This derived type name has not been declared. [SALARIED_EMPLOYEE]
type(salaried_employee),pointer :: sal_emp
--------^
employee.f90(196): error #6457: This derived type name has not been declared. [HOURLY_EMPLOYEE]
type(hourly_employee),pointer :: hourly_emp
--------^
employee.f90(199): error #6404: This name does not have a type, and must have an explicit type. [SAL_EMP]
allocate(sal_emp,stat = istat)
------------^
employee.f90(201): error #6460: This is not a field name that is defined in the encompassing structure. [SET_EMPLOYEE]
call sal_emp%set_employee('john','jones','111-11-1111')
----------------^
employee.f90(202): error #6460: This is not a field name that is defined in the encompassing structure. [SET_SALARY]
call sal_emp%set_salary(3000.0)
----------------^
employee.f90(204): error #6404: This name does not have a type, and must have an explicit type. [HOURLY_EMP]
allocate(hourly_emp,stat = istat)
------------^
employee.f90(206): error #6460: This is not a field name that is defined in the encompassing structure. [SET_PAY_RATE]
call hourly_emp%set_pay_rate(12.50)
-------------------^
compilation aborted for employee.f90 (code 1)

IanH · ‎09-06-2017

In the procedure binding statement for the deferred binding in the extended types, you have the binding name and the associated procedure around the wrong way. Instead of:

procedure,public,nopass:: calc_payx => calc_pay

you want

procedure,public,nopass:: calc_pay  ! => calc_payx

where calc_payx is the name of the specific procedure - it can be left out if the name of the specific procedure is the same as the name of the binding.

qiu_n_ · ‎09-06-2017

thank you ,it's ok,but i have other problem for abstract interface，i want use employee class in my abstract funcation ,how can definite it ? i code is following ,but compile message have error .

module employee_class

type,abstract,public :: employee
private
character(len = 30) :: first_name
character(len = 30) :: last_name
character(len = 11) :: ssn
real :: pay = 0
contains
procedure,public :: set_employee =>set_employee_sub
procedure,public :: set_name =>set_name_sub
procedure,public :: set_ssn =>set_ssn_sub
procedure,public :: set_pay =>set_pay_sub
procedure,public :: get_first_name =>get_first_name_fn
procedure,public :: get_last_name =>get_last_name_fn
procedure,public :: get_ssn =>get_ssn_fn
procedure,public :: get_pay =>get_pay_fn

procedure(calc_payx),public,deferred :: calc_pay

end type employee

abstract interface
real function calc_payx(this,hours,rate)
implicit none
import
class(employee) :: this

! error in here
real,intent(in) :: hours
real,intent(in) :: rate

end function calc_payx
end interface

private :: set_employee_sub,set_name_sub,set_ssn_sub,set_pay_sub
private :: get_first_name_fn,get_last_name_fn,get_ssn_fn
private :: get_pay_fn

contains
subroutine set_employee_sub(this,first,last,ssn)
implicit none
class(employee) :: this
character(len=*) ,intent(in) :: first
character(len=*) ,intent(in) :: last
character(len=*) ,intent(in) :: ssn

this%first_name = first
this%last_name = last
this%ssn = ssn
this%pay = 0

end subroutine set_employee_sub

subroutine set_name_sub(this,first,last)
implicit none
class(employee) :: this
character(len=*),intent(in) :: first
character(len=*),intent(in) :: last

this%first_name = first
this%last_name = last

end subroutine set_name_sub

subroutine set_ssn_sub(this,ssn)
implicit none
class(employee) :: this
character(len=*),intent(in) :: ssn

this%ssn = ssn

end subroutine set_ssn_sub

subroutine set_pay_sub(this,pay)
implicit none
class(employee) :: this
real,intent(in) :: pay

this%pay = pay

end subroutine set_pay_sub

character(len = 30) function get_first_name_fn(this)
implicit none
class(employee) :: this
get_first_name_fn = this%first_name
end function get_first_name_fn

character(len = 30) function get_last_name_fn(this)
implicit none
class(employee) :: this
get_last_name_fn = this%last_name
end function get_last_name_fn

character(len = 11) function get_ssn_fn(this)
implicit none
class(employee) :: this
get_ssn_fn = this%ssn
end function get_ssn_fn

real function get_pay_fn(this)
implicit none
class(employee) :: this
get_pay_fn = this%pay
end function get_pay_fn

!real function calc_pay_fn(this,hours)
! implicit none
! class(employee) :: this
! real,intent(in) :: hours
! calc_pay_fn = 0
!end function calc_pay_fn
end module employee_class
!*------------------------------------------module salaried_employee_class ------------------*
module salaried_employee_class
use employee_class
implicit none
type,public,extends(employee) :: salaried_employee
private
real :: salary = 0
contains
procedure,public :: set_salary => set_salary_sub
procedure,public:: calc_pay

! procedure,public,nopass:: calc_pay
end type salaried_employee
private :: set_salary_sub
contains
subroutine set_salary_sub(this,salary)
implicit none
class(salaried_employee) :: this
real,intent(in) :: salary

call this%set_pay(salary)
this%salary = salary

end subroutine set_salary_sub

real function calc_pay(this,hours,rate)
implicit none
class(salaried_employee) :: this
real,intent(in) :: hours
real,intent(in) :: rate

calc_pay = hours *rate
call this%set_pay(calc_pay)

end function calc_pay
end module salaried_employee_class

!*------------------------------------------module hourly_employee_class ------------------*
module hourly_employee_class
use employee_class
implicit none
type,public,extends(employee) :: hourly_employee
private
real :: rate = 0
contains
procedure,public :: set_pay_rate => set_pay_rate_sub
procedure,public :: calc_pay

! procedure,public,nopass :: calc_pay
end type hourly_employee
private :: set_pay_rate_sub
contains
subroutine set_pay_rate_sub(this,rate)
implicit none
class(hourly_employee) :: this
real,intent(in) :: rate

this%rate = rate

end subroutine set_pay_rate_sub

real function calc_pay(this,hours,rate)
implicit none
class(hourly_employee) :: this
real,intent(in) :: hours
real,intent(in) :: rate
real :: daypay

calc_pay = hours*rate*1.5

end function calc_pay

end module hourly_employee_class

program test_employee
use hourly_employee_class
use salaried_employee_class
implicit none

type(salaried_employee),pointer :: sal_emp
type(hourly_employee),pointer :: hourly_emp
integer ::istat

allocate(sal_emp,stat = istat)

call sal_emp%set_employee('john','jones','111-11-1111')
call sal_emp%set_salary(3000.0)

allocate(hourly_emp,stat = istat)
call hourly_emp%set_employee('jane','jones','222-22-2222')
call hourly_emp%set_pay_rate(12.50)

deallocate(sal_emp)
deallocate(hourly_emp)

end program

following is complie error message :

employee.f90(30): error #8041: The IMPORT statement is not positioned correctly within the scoping unit.
import
---^
employee.f90(31): error #6457: This derived type name has not been declared. [EMPLOYEE]
class(employee) :: this
---------^
employee.f90(28): error #6404: This name does not have a type, and must have an explicit type. [THIS]
real function calc_payx(this,hours,rate)
------------------------^
employee.f90(28): error #8262: For a type-bound procedure that has the PASS binding attribute, the first dummy argument must have the same declared type as the type being defined. [THIS]
real function calc_payx(this,hours,rate)
------------------------^
employee.f90(45): error #6457: This derived type name has not been declared. [EMPLOYEE]
class(employee) :: this
------^
employee.f90(59): error #6457: This derived type name has not been declared. [EMPLOYEE]
class(employee) :: this
------^
employee.f90(70): error #6457: This derived type name has not been declared. [EMPLOYEE]
class(employee) :: this
------^
employee.f90(79): error #6457: This derived type name has not been declared. [EMPLOYEE]
class(employee) :: this
------^
employee.f90(88): error #6457: This derived type name has not been declared. [EMPLOYEE]
class(employee) :: this
---------^
employee.f90(94): error #6457: This derived type name has not been declared. [EMPLOYEE]
class(employee) :: this

.........

Juergen_R_R · ‎09-07-2017

The import statement has to be before the implicit none. Then the code compiles.

qiu_n_ · ‎09-07-2017

thank you. no problem it's ok!

abstract class and interface problem