aboutsummaryrefslogtreecommitdiff
path: root/favorites.f90
diff options
context:
space:
mode:
Diffstat (limited to 'favorites.f90')
-rw-r--r--favorites.f9022
1 files changed, 14 insertions, 8 deletions
diff --git a/favorites.f90 b/favorites.f90
index f83d026..a1e0a6b 100644
--- a/favorites.f90
+++ b/favorites.f90
@@ -8,7 +8,7 @@ implicit none
type :: favorite
- character(80)::name
+ character(1024)::name
character(1024)::link
integer::added
@@ -155,6 +155,7 @@ contains
do while(c /= ' ' .and. c /= char(9))
res%link(i:i) = c
read(unit_number, '(A1)', advance='no') c
+ i = i + 1
end do
! Separating spaces...
@@ -165,9 +166,11 @@ contains
! Name...
res%name = " "
ios = 0
- do while(c /= ' ' .and. c /= char(9))
+ i = 1
+ do while(ios == 0)
res%name(i:i) = c
read(unit_number, '(A1)', advance='no', iostat=ios) c
+ i = i + 1
end do
! The date should be at the end of the link
@@ -190,24 +193,27 @@ contains
type(favorite), dimension(:), pointer::faves
character(80)::temp
- integer::n, i
+ integer::n, i, ios
! Title
read(unit_number, *) temp
! Blank
- read(unit_number, *) temp
+ !read(unit_number, *) temp
! Count
read(unit_number, *) n
! Blank
- read(unit_number, *) temp
+ !read(unit_number, *) temp
allocate(faves(n))
do i = 1, n
- read(unit_number, '(A2)', advance='no') temp
+ ios = 1
+ do while(ios /= 0)
+ read(unit_number, '(A2)', advance='no', iostat=ios) temp
+ end do
faves(i) = read_favorite(unit_number)
end do
@@ -219,8 +225,8 @@ contains
integer, intent(in)::unit_number
type(favorite), intent(in)::f
- write(unit_number, '(A3)', advance='no') "=> "
- write(unit_number, *) trim(f%link)//" "//f%name
+ write(unit_number, '(A2)', advance='no') "=>"
+ write(unit_number, *) trim(f%link)//" "//trim(f%name)
end subroutine write_favorite