- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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)
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
.........
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The import statement has to be before the implicit none. Then the code compiles.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
thank you. no problem it's ok!
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page