1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
| module product_class implicit none private
public :: ProductClass
type :: PartList character(len=256) :: data type(PartList), pointer :: next => null() end type PartList
type :: ProductClass integer :: id character(len=256) :: name type(PartList), pointer :: parts => null() contains procedure, pass, public :: add_part => add_part procedure, pass, public :: show_parts => show_parts final :: destructor end type ProductClass
contains
subroutine add_part(this, part) class(ProductClass), intent(inout) :: this character(len=*), intent(in) :: part type(PartList), pointer :: new_node type(PartList), pointer :: current
allocate(new_node) new_node%data = part new_node%next => null()
if (.not. associated(this%parts)) then this%parts => new_node else current => this%parts do while (associated(current%next)) current => current%next end do current%next => new_node end if end subroutine add_part
subroutine show_parts(this) class(ProductClass), intent(in) :: this type(PartList), pointer :: current
print *, "Product parts:" current => this%parts do while (associated(current)) print *, current%data current => current%next end do print *, "ID:", this%id, ", Name:", this%name end subroutine show_parts
subroutine destructor(this) type(ProductClass), intent(inout) :: this type(PartList), pointer :: current, next
current => this%parts do while (associated(current)) next => current%next deallocate(current) current => next end do this%parts => null() end subroutine destructor
end module product_class
|