Skip to content
Snippets Groups Projects
Commit ee2a0812 authored by Luis Kornblueh's avatar Luis Kornblueh
Browse files

Updated hl constructors as asked for

parent dbf4efcc
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
examples/example_hl.f90
+ 7
− 7
View file @ ee2a0812
......@@ -51,7 +51,7 @@ PROGRAM example
! TYPE(t_datetime) :: dt
WRITE (0,*) " testing assignment of t_datetime."
dt = "1970-01-01T00:00:00"
dt = t_datetime("1970-01-01T00:00:00")
! Instead of: TYPE(timedelta), POINTER :: td
! td => newTimeDelta("PT1H1M1S")
......@@ -60,7 +60,7 @@ PROGRAM example
! TYPE(t_timedelta) :: td
WRITE (0,*) " testing assignment of t_timedelta."
td = "PT1H1M1S"
td = t_timedelta("PT1H1M1S")
! Instead of: CALL datetimeToString(dt, dstring1)
! CALL timedeltaToString(td, dstring2)
......@@ -76,19 +76,19 @@ PROGRAM example
! --- Further examples:
! subtraction of two dates
dt2 = "1970-01-01T00:00:00"
dt2 = t_datetime("1970-01-01T00:00:00")
td = dt-dt2
WRITE (0,*) "subtraction of dates: time delta: ", td%to_string()
! comparison of dates
dt = "1970-01-01T00:00:00"
dt2 = "1970-01-01T00:00:00"
dt = t_datetime("1970-01-01T00:00:00")
dt2 = t_datetime("1970-01-01T00:00:00")
WRITE (0,*) dt%to_string(), " == ", dt2%to_string(), ": ", (dt == dt2)
dt3 = "1970-01-01T00:00:01"
dt3 = t_datetime("1970-01-01T00:00:01")
WRITE (0,*) dt%to_string(), " == ", dt3%to_string(), ": ", (dt == dt3)
! interval assignment with milliseconds
td = 360000
td = t_timedelta(360000)
WRITE (0,*) "interval assignment with milliseconds: ", td%to_string()
! ------------------------------------------------------------
......
src/libmtime_hl.f90
+ 79
− 51
View file @ ee2a0812
......@@ -19,12 +19,10 @@ module mtime_hl
public :: t_datetime, t_timedelta
INTEGER, PARAMETER :: i8 = SELECTED_INT_KIND(14) !< at least 8 byte integer
integer, parameter :: i8 = selected_int_kind(14) !< at least 8 byte integer
!> Wrapper class for "mtime" data type "datetime".
!
! Avoids, e.g., explicit use of POINTERs by the user.
!
type t_datetime
private
......@@ -33,8 +31,8 @@ module mtime_hl
contains
procedure :: assign_t_datetime
procedure :: day => t_datetime_day
procedure :: assign_string => t_datetime_assign_string
procedure :: add_timedelta => t_datetime_add_timedelta
procedure :: sub_timedelta => t_datetime_sub_timedelta
procedure :: sub_datetime => t_datetime_sub_datetime
......@@ -50,7 +48,7 @@ module mtime_hl
generic :: to_string => t_datetime_to_string, t_datetime_to_posix_string
generic :: assignment(=) => assign_string
generic :: assignment(=) => assign_t_datetime
generic :: operator(+) => add_timedelta
generic :: operator(-) => sub_timedelta
generic :: operator(-) => sub_datetime
......@@ -63,11 +61,12 @@ module mtime_hl
end type t_datetime
interface t_datetime
module procedure t_datetime_assign_string
end interface t_datetime
!> Wrapper class for "mtime" data type "timedelta".
!
! Avoids, e.g., explicit use of POINTERs by the user.
!
type t_timedelta
private
......@@ -76,17 +75,20 @@ module mtime_hl
contains
procedure :: assign_string => t_timedelta_assign_string
procedure :: assign_ms => t_timedelta_assign_ms
procedure :: assign_t_timedelta
procedure :: t_timedelta_to_string
generic :: to_string => t_timedelta_to_string
generic :: to_string => t_timedelta_to_string
generic :: assignment(=) => assign_string, assign_ms
generic :: assignment(=) => assign_t_timedelta
end type t_timedelta
interface t_timedelta
module procedure t_timedelta_assign_string
module procedure t_timedelta_assign_ms
end interface t_timedelta
!> Error info type: mtime error
type, extends(t_error_info) :: t_mtime_error
......@@ -94,6 +96,30 @@ module mtime_hl
contains
!___________________________________________________________________________
! datetime section:
!
! generic assignment for constructors
!
subroutine assign_t_datetime(to, from)
class(t_datetime), intent(out) :: to
class(t_datetime), intent(in) :: from
type(datetime), pointer :: dt_tmp
dt_tmp => newdatetime(from%dt)
to%dt = dt_tmp
call deallocatedatetime(dt_tmp)
end subroutine assign_t_datetime
! constructor for a datetime string
!
type(t_datetime) function t_datetime_assign_string(dt_string)
character(len=*), intent(in) :: dt_string
type(datetime), pointer :: dt_tmp
dt_tmp => newdatetime(dt_string)
t_datetime_assign_string%dt = dt_tmp
call deallocatedatetime(dt_tmp)
end function t_datetime_assign_string
! Returns t_datetime objects day
!
function t_datetime_day(this)
......@@ -147,17 +173,6 @@ contains
call deallocatedatetime(dt_tmp)
end function t_datetime_to_posix_string
! Assignment operator: this = "date string".
!
subroutine t_datetime_assign_string(this, dt_string)
class (t_datetime), intent(out) :: this
character(len=*), intent(in) :: dt_string
type(datetime), pointer :: dt_tmp
dt_tmp => newDatetime(dt_string)
this%dt = dt_tmp
call deallocateDatetime(dt_tmp)
end subroutine t_datetime_assign_string
! Addition of time interval to datetime object.
!
function t_datetime_add_timedelta(this, td) result(dt_td_sum)
......@@ -241,13 +256,52 @@ contains
class (t_datetime), intent(in) :: dt
t_datetime_greater_or_equal = (this%dt >= dt%dt)
end function t_datetime_greater_or_equal
!___________________________________________________________________________
! timedelta section:
!
! generic assignment for constructors
!
subroutine assign_t_timedelta(to, from)
class(t_timedelta), intent(out) :: to
class(t_timedelta), intent(in) :: from
type(timedelta), pointer :: td_tmp
td_tmp => newTimedelta(from%td)
to%td = td_tmp
to%td%sign = td_tmp%sign
call deallocateTimedelta(td_tmp)
end subroutine assign_t_timedelta
! constructor for timedelta string
!
type(t_timedelta) function t_timedelta_assign_string(td_string)
character(len=*), intent(in) :: td_string
type(timedelta), pointer :: td_tmp
td_tmp => newtimedelta(td_string)
t_timedelta_assign_string%td = td_tmp
t_timedelta_assign_string%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp)
end function t_timedelta_assign_string
! constructor for integer milliseconds (integer)
!
type(t_timedelta) function t_timedelta_assign_ms(td_ms)
integer, intent(in) :: td_ms
type(timedelta), pointer :: td_tmp
character(len=max_timedelta_str_len) :: td_string
call getptstringfromms(int(td_ms,i8), td_string)
td_tmp => newtimedelta(td_string)
t_timedelta_assign_ms%td = td_tmp
t_timedelta_assign_ms%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp)
end function t_timedelta_assign_ms
! Convert t_timedelta object to string.
!
FUNCTION t_timedelta_to_string(this, opt_error)
function t_timedelta_to_string(this, opt_error)
character(len=max_timedelta_str_len) :: t_timedelta_to_string
class (t_timedelta) :: this
TYPE(t_error), INTENT(OUT), OPTIONAL :: opt_error
type(t_error), intent(out), optional :: opt_error
type(timedelta), pointer :: td_tmp
INTEGER :: errno
character(len=max_error_str_len) :: error_str
......@@ -264,32 +318,6 @@ contains
call deallocatetimedelta(td_tmp)
end function t_timedelta_to_string
! Assignment operator: this = "time interval string".
!
subroutine t_timedelta_assign_string(this, td_string)
class (t_timedelta), intent(out) :: this
character(len=*), intent(in) :: td_string
type(timedelta), pointer :: td_tmp
td_tmp => newtimedelta(td_string)
this%td = td_tmp
this%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp)
end subroutine t_timedelta_assign_string
! Assignment operator: this = milliseconds.
!
subroutine t_timedelta_assign_ms(this, td_ms)
class (t_timedelta), intent(out) :: this
integer, intent(in) :: td_ms
type(timedelta), pointer :: td_tmp
character(len=max_timedelta_str_len) :: td_string
call getptstringfromms(int(td_ms,i8), td_string)
td_tmp => newtimedelta(td_string)
this%td = td_tmp
this%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp)
end subroutine t_timedelta_assign_ms
end module mtime_hl
!>
!! @}
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Imprint | Privacy Policy