!> Implementation of versioning data for comparing packages module fpm_versioning use fpm_error, only : error_t, syntax_error use fpm_strings, only: string_t use regex_module, only: regex implicit none private public :: version_t, new_version public :: regex_version_from_text type :: version_t private !> Version numbers found integer, allocatable :: num(:) contains generic :: operator(==) => equals procedure, private :: equals generic :: operator(/=) => not_equals procedure, private :: not_equals generic :: operator(>) => greater procedure, private :: greater generic :: operator(<) => less procedure, private :: less generic :: operator(>=) => greater_equals procedure, private :: greater_equals generic :: operator(<=) => less_equals procedure, private :: less_equals !> Compare a version against a version constraint (x.x.0 <= v < x.x.HUGE) generic :: operator(.match.) => match procedure, private :: match !> Create a printable string from a version data type procedure :: s end type version_t !> Arbitrary internal limit of the version parser integer, parameter :: max_limit = 3 interface new_version module procedure :: new_version_from_string module procedure :: new_version_from_int end interface new_version contains !> Create a new version from a string subroutine new_version_from_int(self, num) !> Instance of the versioning data type(version_t), intent(out) :: self !> Subversion numbers to define version data integer, intent(in) :: num(:) self%num = num end subroutine new_version_from_int !> Create a new version from a string subroutine new_version_from_string(self, string, error) !> Instance of the versioning data type(version_t), intent(out) :: self !> String describing the version information character(len=*), intent(in) :: string !> Error handling type(error_t), allocatable, intent(out) :: error integer :: istart, iend, stat, nn integer :: num(max_limit) logical :: is_number nn = 0 iend = 0 istart = 0 is_number = .false. do while(iend < len(string)) call next(string, istart, iend, is_number, error) if (allocated(error)) exit if (is_number) then if (nn >= max_limit) then call token_error(error, string, istart, iend, & & "Too many subversions found") exit end if nn = nn + 1 read(string(istart:iend), *, iostat=stat) num(nn) if (stat /= 0) then call token_error(error, string, istart, iend, & & "Failed to parse version number") exit end if end if end do if (allocated(error)) return if (.not.is_number) then call token_error(error, string, istart, iend, & & "Expected version number, but no characters are left") return end if call new_version(self, num(:nn)) end subroutine new_version_from_string !> Tokenize a version string subroutine next(string, istart, iend, is_number, error) !> String describing the version information character(len=*), intent(in) :: string !> Start of last token, start of next token on exit integer, intent(inout) :: istart !> End of last token on entry, end of next token on exit integer, intent(inout) :: iend !> Token produced is a number logical, intent(inout) :: is_number !> Error handling type(error_t), allocatable, intent(out) :: error integer :: ii, nn logical :: was_number character :: tok was_number = is_number nn = len(string) if (iend >= nn) then istart = nn iend = nn return end if ii = min(iend + 1, nn) tok = string(ii:ii) is_number = tok /= '.' if (is_number .eqv. was_number) then call token_error(error, string, istart, ii, & & "Unexpected token found") return end if if (.not.is_number) then is_number = .false. istart = ii iend = ii return end if istart = ii do ii = min(iend + 1, nn), nn tok = string(ii:ii) select case(tok) case default call token_error(error, string, istart, ii, & & "Invalid character in version number") exit case('.') exit case('0', '1', '2', '3', '4', '5', '6', '7', '8', '9') iend = ii cycle end select end do end subroutine next !> Create an error on an invalid token, provide some visual context as well subroutine token_error(error, string, istart, iend, message) !> Error handling type(error_t), allocatable, intent(out) :: error !> String describing the version information character(len=*), intent(in) :: string !> Start of last token, start of next token on exit integer, intent(in) :: istart !> End of last token on entry, end of next token on exit integer, intent(in) :: iend !> Error message character(len=*), intent(in) :: message character(len=*), parameter :: nl = new_line('a') allocate(error) error%message = message // nl // " | " // string // nl // & & " |" // repeat('-', istart) // repeat('^', iend - istart + 1) end subroutine token_error pure function s(self) result(string) !> Version number class(version_t), intent(in) :: self !> Character representation of the version character(len=:), allocatable :: string integer, parameter :: buffersize = 64 character(len=buffersize) :: buffer integer :: ii do ii = 1, ndigits(self) if (allocated(string)) then write(buffer, '(".", i0)') self%num(ii) string = string // trim(buffer) else write(buffer, '(i0)') self%num(ii) string = trim(buffer) end if end do if (.not.allocated(string)) then string = '0' end if end function s !> Check to version numbers for equality elemental function equals(lhs, rhs) result(is_equal) !> First version number class(version_t), intent(in) :: lhs !> Second version number class(version_t), intent(in) :: rhs !> Version match logical :: is_equal is_equal = .not.(lhs > rhs) if (is_equal) then is_equal = .not.(rhs > lhs) end if end function equals !> Check two versions for inequality elemental function not_equals(lhs, rhs) result(not_equal) !> First version number class(version_t), intent(in) :: lhs !> Second version number class(version_t), intent(in) :: rhs !> Version mismatch logical :: not_equal not_equal = lhs > rhs if (.not.not_equal) then not_equal = rhs > lhs end if end function not_equals !> Relative comparison of two versions elemental function greater(lhs, rhs) result(is_greater) !> First version number class(version_t), intent(in) :: lhs !> Second version number class(version_t), intent(in) :: rhs !> First version is greater logical :: is_greater integer :: ii, lhs_size, rhs_size do ii = 1, min(ndigits(lhs),ndigits(rhs)) if (lhs%num(ii) /= rhs%num(ii)) then is_greater = lhs%num(ii) > rhs%num(ii) return end if end do is_greater = ndigits(lhs) > ndigits(rhs) if (is_greater) then do ii = ndigits(rhs) + 1, ndigits(lhs) is_greater = lhs%num(ii) > 0 if (is_greater) return end do end if end function greater !> Relative comparison of two versions elemental function less(lhs, rhs) result(is_less) !> First version number class(version_t), intent(in) :: lhs !> Second version number class(version_t), intent(in) :: rhs !> First version is less logical :: is_less is_less = rhs > lhs end function less !> Relative comparison of two versions elemental function greater_equals(lhs, rhs) result(is_greater_equal) !> First version number class(version_t), intent(in) :: lhs !> Second version number class(version_t), intent(in) :: rhs !> First version is greater or equal logical :: is_greater_equal is_greater_equal = .not. (rhs > lhs) end function greater_equals !> Relative comparison of two versions elemental function less_equals(lhs, rhs) result(is_less_equal) !> First version number class(version_t), intent(in) :: lhs !> Second version number class(version_t), intent(in) :: rhs !> First version is less or equal logical :: is_less_equal is_less_equal = .not. (lhs > rhs) end function less_equals !> Try to match first version against second version elemental function match(lhs, rhs) !> First version number class(version_t), intent(in) :: lhs !> Second version number class(version_t), intent(in) :: rhs !> Version match following semantic versioning rules logical :: match type(version_t) :: tmp match = .not.(rhs > lhs) if (match) then tmp%num = rhs%num tmp%num(size(tmp%num)) = tmp%num(size(tmp%num)) + 1 match = tmp > lhs end if end function match !> Number of digits elemental integer function ndigits(self) class(version_t), intent(in) :: self if (allocated(self%num)) then ndigits = size(self%num) else ndigits = 0 end if end function ndigits ! Extract canonical version flags "1.0.0" or "1.0" as the first instance inside a text ! (whatever long) using regex type(string_t) function regex_version_from_text(text,what,error) result(ver) character(*), intent(in) :: text character(*), intent(in) :: what type(error_t), allocatable, intent(out) :: error integer :: ire, length if (len_trim(text)<=0) then call syntax_error(error,'cannot retrieve '//what//' version: empty input string') return end if ! Extract 3-sized version "1.0.4" ire = regex(text,'\d+\.\d+\.\d+',length=length) if (ire>0 .and. length>0) then ! Parse version into the object (this should always work) ver = string_t(text(ire:ire+length-1)) else ! Try 2-sized version "1.0" ire = regex(text,'\d+\.\d+',length=length) if (ire>0 .and. length>0) then ver = string_t(text(ire:ire+length-1)) else call syntax_error(error,'cannot retrieve '//what//' version.') end if end if end function regex_version_from_text end module fpm_versioning