json_value_equals Function

private recursive function json_value_equals(json, p1, p2, verbose) result(equals)

Compare two JSON structures for equality.

This function recursively traverses both structures and checks that they have: * The same variable types * The same values (for primitives) * The same number of children (for objects and arrays) * The same structure (recursively)

Example

 type(json_core) :: json
 type(json_value),pointer :: p1, p2
 logical :: are_equal
 call json%load(file='file1.json', p=p1)
 call json%load(file='file2.json', p=p2)
 are_equal = json%equals(p1, p2)
 if (are_equal) then
     write(*,*) 'Files are identical'
 else
     write(*,*) 'Files differ'
 end if

Type Bound

json_core

Arguments

Type IntentOptional Attributes Name
class(json_core), intent(inout) :: json
type(json_value), pointer :: p1

first JSON structure
type(json_value), pointer :: p2

second JSON structure
logical(kind=LK), intent(in), optional :: verbose

if true, print debug info. [default is false]

Return Value logical(kind=LK)

true if the structures are equal


Calls

proc~~json_value_equals~~CallsGraph proc~json_value_equals json_core%json_value_equals proc~json_value_equals->proc~json_value_equals none~get_child json_core%get_child proc~json_value_equals->none~get_child proc~json_value_get_child json_core%json_value_get_child none~get_child->proc~json_value_get_child proc~json_value_get_child_by_index json_core%json_value_get_child_by_index none~get_child->proc~json_value_get_child_by_index proc~json_value_get_child_by_name json_core%json_value_get_child_by_name none~get_child->proc~json_value_get_child_by_name none~throw_exception json_core%throw_exception proc~json_value_get_child->none~throw_exception proc~json_value_get_child_by_index->none~throw_exception proc~json_clear_exceptions json_core%json_clear_exceptions proc~json_value_get_child_by_index->proc~json_clear_exceptions proc~json_value_get_child_by_name->none~throw_exception proc~json_value_get_child_by_name->proc~json_clear_exceptions proc~name_equal json_core%name_equal proc~json_value_get_child_by_name->proc~name_equal proc~json_throw_exception json_core%json_throw_exception none~throw_exception->proc~json_throw_exception proc~name_strings_equal json_core%name_strings_equal proc~name_equal->proc~name_strings_equal proc~lowercase_string lowercase_string proc~name_strings_equal->proc~lowercase_string

Source Code

    recursive function json_value_equals(json, p1, p2, verbose) result(equals)

    implicit none

    class(json_core),intent(inout)   :: json
    type(json_value),pointer         :: p1      !! first JSON structure
    type(json_value),pointer         :: p2      !! second JSON structure
    logical(LK)                      :: equals  !! true if the structures are equal
    logical(LK),intent(in),optional  :: verbose !! if true, print debug info. [default is false]

    integer(IK) :: n1, n2  !! number of children
    type(json_value),pointer :: child1, child2  !! for iterating children
    logical(LK) :: child_found  !! for get_child calls
    logical(LK) :: debug  !! if `verbose` is set

    ! Initialize
    equals = .false.

    if (present(verbose)) then
        debug = verbose
    else
        debug = .false.
    end if

    ! Check if both are null
    if (.not. associated(p1) .and. .not. associated(p2)) then
        equals = .true.
        return
    end if

    ! Check if only one is null
    if (.not. associated(p1) .or. .not. associated(p2)) then
        if (debug) write(error_unit,'(A)') 'One pointer is null, the other is not'
        equals = .false.
        return
    end if

    ! Check if variable types match
    if (p1%var_type /= p2%var_type) then
        if (debug) write(error_unit,'(A,I0,A,I0)') 'Type mismatch: p1%var_type=', &
            p1%var_type, ', p2%var_type=', p2%var_type
        equals = .false.
        return
    end if

    ! Compare based on type
    select case (p1%var_type)

    case (json_null)
        ! Both are null, already validated by type check
        equals = .true.

    case (json_logical)
        ! Compare logical values
        if (allocated(p1%log_value) .and. allocated(p2%log_value)) then
            equals = (p1%log_value .eqv. p2%log_value)
            if (.not. equals .and. debug) then
                write(error_unit,'(A)') 'Logical values differ'
                write(error_unit,'(A,L1)') '  p1: ', p1%log_value
                write(error_unit,'(A,L1)') '  p2: ', p2%log_value
            end if
        else if (.not. allocated(p1%log_value) .and. .not. allocated(p2%log_value)) then
            equals = .true.
        else
            if (debug) write(error_unit,'(A)') 'Logical allocation mismatch'
            equals = .false.
        end if

    case (json_integer)
        ! Compare integer values
        if (allocated(p1%int_value) .and. allocated(p2%int_value)) then
            equals = (p1%int_value == p2%int_value)
            if (.not. equals .and. debug) then
                write(error_unit,'(A)') 'Integer values differ'
                write(error_unit,'(A,I0)') '  p1: ', p1%int_value
                write(error_unit,'(A,I0)') '  p2: ', p2%int_value
            end if
        else if (.not. allocated(p1%int_value) .and. .not. allocated(p2%int_value)) then
            equals = .true.
        else
            if (debug) write(error_unit,'(A)') 'Integer allocation mismatch'
            equals = .false.
        end if

    case (json_real)
        ! Compare real values with tolerance
        if (allocated(p1%dbl_value) .and. allocated(p2%dbl_value)) then
            associate (r1 => p1%dbl_value, r2 => p2%dbl_value)
                ! Handle special cases: NaN, Inf, -Inf
                if (ieee_is_nan(r1) .and. ieee_is_nan(r2)) then
                    equals = .true.
                else if (ieee_is_nan(r1) .or. ieee_is_nan(r2)) then
                    if (debug) write(error_unit,'(A)') 'One value is NaN, the other is not'
                    equals = .false.
                else if (.not. ieee_is_finite(r1) .and. .not. ieee_is_finite(r2)) then
                    ! Both infinite - check if same sign
                    equals = (r1 == r2)
                    if (debug .and. .not. equals) write(error_unit,'(A)') 'Both values are infinite but have different signs'
                else if (ieee_is_finite(r1) .and. ieee_is_finite(r2)) then
                    ! Both finite:
                    equals = r1 == r2
                    if (.not. equals .and. debug) then
                        write(error_unit,'(A)') 'Real values differ'
                        write(error_unit,'(A,F24.16)') '  p1: ', r1
                        write(error_unit,'(A,F24.16)') '  p2: ', r2
                    end if
                else
                    if (debug) write(error_unit,'(A)') 'One value is finite, the other is not'
                    equals = .false.
                end if
            end associate
        else if (.not. allocated(p1%dbl_value) .and. .not. allocated(p2%dbl_value)) then
            equals = .true.
        else
            if (debug) write(error_unit,'(A)') 'Real allocation mismatch'
            equals = .false.
        end if

    case (json_string)
        ! Compare string values
        if (allocated(p1%str_value) .and. allocated(p2%str_value)) then
            equals = (p1%str_value == p2%str_value)
            if (.not. equals .and. debug) then
                write(error_unit,'(A)') 'String values differ'
                write(error_unit,'(A,A,A)') '  p1: "', p1%str_value, '"'
                write(error_unit,'(A,A,A)') '  p2: "', p2%str_value, '"'
            end if
        else if (.not. allocated(p1%str_value) .and. .not. allocated(p2%str_value)) then
            equals = .true.
        else
            if (debug) write(error_unit,'(A)') 'String allocation mismatch'
            equals = .false.
        end if

    case (json_array)
        ! Compare arrays: must have same number of elements in same order
        n1 = json%count(p1)
        n2 = json%count(p2)

        if (n1 /= n2) then
            if (debug) write(error_unit,'(A,I0,A,I0)') 'Array size mismatch: n1=', n1, ', n2=', n2
            equals = .false.
            return
        end if

        ! Compare each element
        child1 => p1%children
        child2 => p2%children

        do while (associated(child1) .and. associated(child2))
            ! Recursively compare children
            if (.not. json%equals(child1, child2)) then
                if (debug) write(error_unit,'(A)') 'Array element mismatch'
                equals = .false.
                return
            end if
            child1 => child1%next
            child2 => child2%next
        end do

        ! If we got here, all elements matched
        equals = .true.

    case (json_object)
        ! Compare objects: must have same keys with same values
        n1 = json%count(p1)
        n2 = json%count(p2)

        if (n1 /= n2) then
            if (debug) write(error_unit,'(A,I0,A,I0)') 'Object size mismatch: n1=', n1, ', n2=', n2
            equals = .false.
            return
        end if

        ! For each child in p1, find matching child in p2 by name
        child1 => p1%children

        do while (associated(child1))
            ! Look for child with same name in p2
            nullify(child2)
            if (allocated(child1%name)) then
                call json%get_child(p2, child1%name, child2, child_found)
                if (.not. child_found) then
                    ! Key not found in p2
                    if (debug) write(error_unit,'(A,A,A)') 'Key not found in p2: "', child1%name, '"'
                    equals = .false.
                    return
                end if

                ! Recursively compare values
                if (.not. json%equals(child1, child2)) then
                    if (debug) write(error_unit,'(A,A,A)') 'Value mismatch for key: "', child1%name, '"'
                    equals = .false.
                    return
                end if
            end if

            child1 => child1%next
        end do

        ! If we got here, all keys and values matched
        equals = .true.

    case default
        ! Unknown type
        if (debug) write(error_unit,'(A)') 'Unknown variable type encountered'
        equals = .false.
    end select

    end function json_value_equals