@@ -3466,6 +3466,7 @@ recursive subroutine parse_object(unit, parent)
3466
3466
else if (' "' == c) then
3467
3467
call json_value_create(pair)
3468
3468
call parse_string(unit, pair % name)
3469
+ if (exception_thrown) return
3469
3470
else
3470
3471
call throw_exception(' Error in parse_object: Expecting string: "' // c// ' "' )
3471
3472
call cleanup()
@@ -3481,6 +3482,7 @@ recursive subroutine parse_object(unit, parent)
3481
3482
else if (' :' == c) then
3482
3483
! parse the value
3483
3484
call parse_value(unit, pair)
3485
+ if (exception_thrown) return
3484
3486
call json_value_add(parent, pair)
3485
3487
else
3486
3488
call throw_exception(' Error in parse_object: Expecting : and then a value: ' // c)
@@ -3551,6 +3553,7 @@ recursive subroutine parse_array(unit, array)
3551
3553
! try to parse an element value
3552
3554
call json_value_create(element)
3553
3555
call parse_value(unit, element)
3556
+ if (exception_thrown) return
3554
3557
3555
3558
! parse value will disassociate an empty array value
3556
3559
if (associated (element)) then
@@ -3566,6 +3569,7 @@ recursive subroutine parse_array(unit, array)
3566
3569
else if (' ,' == c) then
3567
3570
! parse the next element
3568
3571
call parse_array(unit, array)
3572
+ if (exception_thrown) return
3569
3573
else if (' ]' == c) then
3570
3574
! end of array
3571
3575
return
@@ -3583,7 +3587,10 @@ end subroutine parse_array
3583
3587
! parse_string
3584
3588
!
3585
3589
! DESCRIPTION
3590
+ ! Parses a string while reading a json file
3586
3591
!
3592
+ ! HISTORY
3593
+ ! JW : 6/16/2014 : added hex validation.
3587
3594
!
3588
3595
! SOURCE
3589
3596
@@ -3594,25 +3601,74 @@ subroutine parse_string(unit, string)
3594
3601
integer , intent (in ) :: unit
3595
3602
character (len= :),allocatable ,intent (out ) :: string
3596
3603
3597
- logical :: eof
3604
+ logical :: eof, is_hex, escape
3598
3605
character (len= 1 ) :: c, last
3606
+ character (len= 4 ) :: hex
3607
+ integer :: i
3599
3608
3600
3609
if (.not. exception_thrown) then
3601
3610
3602
- string = ' ' ! initialize string
3603
- last = ' ' !
3604
-
3611
+ ! initialize:
3612
+ string = ' '
3613
+ last = space
3614
+ is_hex = .false.
3615
+ escape = .false.
3616
+ i = 0
3617
+
3605
3618
do
3619
+
3620
+ ! get the next character from the file:
3606
3621
c = pop_char(unit, eof = eof, skip_ws = .false. )
3622
+
3607
3623
if (eof) then
3624
+
3608
3625
call throw_exception(' Error in parse_string: Expecting end of string' )
3609
3626
return
3627
+
3610
3628
else if (' "' == c .and. last /= ' \' ) then
3629
+
3630
+ if (is_hex) call throw_exception(' Error in parse_string: incomplete hex string: \u' // trim (hex))
3611
3631
exit
3632
+
3612
3633
else
3634
+
3635
+ ! append to string:
3636
+ string = string// c
3637
+
3638
+ ! hex validation:
3639
+ if (is_hex) then ! accumulate the four characters after '\u'
3640
+
3641
+ i= i+1
3642
+ hex(i:i) = c
3643
+ if (i== 4 ) then
3644
+ if (valid_json_hex(hex)) then
3645
+ i = 0
3646
+ hex = ' '
3647
+ is_hex = .false.
3648
+ else
3649
+ call throw_exception(' Error in parse_string: invalid hex string: \u' // trim (hex))
3650
+ exit
3651
+ end if
3652
+ end if
3653
+
3654
+ else
3655
+
3656
+ ! when the '\u' string is encountered, then
3657
+ ! start accumulating the hex string (should be the next 4 characters)
3658
+ if (escape) then
3659
+ escape = .false.
3660
+ is_hex = (c==' u' ) ! the next four characters are the hex string
3661
+ else
3662
+ escape = (c==' \' )
3663
+ end if
3664
+
3665
+ end if
3666
+
3667
+ ! update for next char:
3613
3668
last = c
3614
- string = string // c ! append to string
3669
+
3615
3670
end if
3671
+
3616
3672
end do
3617
3673
3618
3674
end if
0 commit comments