September Morn Update

Task/Menu/Fortran/menu.f

@@ -1,80 +1,56 @@
-!-*- mode: compilation; default-directory: "/tmp/" -*-
-!Compilation started at Mon Jun  3 23:08:36
-!
 !a=./f && make $a && OMP_NUM_THREADS=2 $a
 !gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none f.f08 -o f
-!
-!$ ./f
-! Choose fairly a tail
-!       1: fee fie
-!       2: huff and puff
-!       3: mirror mirror
-!       4: tick tock
-!bad input
-! Choose fairly a tail
-!       1: fee fie
-!       2: huff and puff
-!       3: mirror mirror
-!       4: tick tock
-!^D
-!
-!STOP Unexpected end of file
-!$ ./f
-! Choose fairly a tail
-!       1: fee fie
-!       2: huff and puff
-!       3: mirror mirror
-!       4: tick tock
-!88
-! Choose fairly a tail
-!       1: fee fie
-!       2: huff and puff
-!       3: mirror mirror
-!       4: tick tock
-!-88
-! Choose fairly a tail
-!       1: fee fie
-!       2: huff and puff
-!       3: mirror mirror
-!       4: tick tock
-!3.2
-! Choose fairly a tail
-!       1: fee fie
-!       2: huff and puff
-!       3: mirror mirror
-!       4: tick tock
-!2
-! huff and puff
-!$
 
-module menu
-contains
-  function selector(title, options, n) result(choice)
-    integer, optional, intent(in) :: n
-    character(len=*), intent(in) :: title
-    character(len=*),dimension(:),intent(in) :: options
-    !character(len=:), allocatable :: choice ! requires deallocation
-    !allocate(character(len=8)::choice)
-    character(len=128) :: choice
-    integer :: i, L, ios
-    L = merge(n, size(options), present(n))
-    if (L .lt. 1) stop 'Silly input'
-    if (len(choice) .lt. len(options(1))) stop 'menu choices are excessively long'
-    i = 0
-    do while ((ios.ne.0) .or. ((i.lt.1) .or. (L.lt.i)))
-       write(6,*) title
-       write(6,"(i8,': ',a)")(i,options(i),i=1,L)
-       read(5,*,iostat=ios,end=666) i
-    end do
-    choice = options(i)
-    return
-666 continue
-    stop 'Unexpected end of file'
-  end function selector
-end module menu
+      module menu
+      public :: selector
+      contains
 
-program menu_demo
-  use menu
-  character(len=14), dimension(4) :: items = (/'fee fie       ', 'huff and puff ', 'mirror mirror ','tick tock     '/)
-  print*,selector('Choose fairly a tail', items)
-end program menu_demo
+      function selector(title,options) result(choice)
+      character(len=*),intent(in) :: title
+      character(len=*),dimension(:),intent(in) :: options
+      character(len=len(options)) :: choice
+      integer :: i,ichoose,ios,n
+
+      choice = ""
+
+      n = size(options)
+      if (n > 0) then
+        do
+          print "(a)",title
+          print "(i8,"", "",a)",(i,options(i),i=1,n)
+          read (*,fmt="(i8)",iostat=ios) ichoose
+
+          if (ios == -1) exit ! EOF error
+          if (ios /= 0) cycle ! other error
+          if (ichoose < 1) cycle
+          if (ichoose > n) cycle ! out-of-bounds
+
+          choice = options(ichoose)
+          exit
+        end do
+      end if
+      end function selector
+      end module menu
+
+      program menu_demo
+      use menu
+      character(len=14),dimension(:),allocatable :: zero_items,fairytale
+      character(len=len(zero_items)) :: s
+
+      !! empty list demo
+      allocate(zero_items(0))
+      print "(a)","input items:",zero_items
+      s = selector('Choose from the empty list',zero_items)
+      print "(a)","returned:",s
+      if (s == "") print "(a)","(an empty string)"
+
+      !! Fairy tale demo
+      allocate(fairytale(4))
+      fairytale = (/'fee fie       ','huff and puff ', &
+        'mirror mirror ','tick tock     '/)
+      print "(a)","input items:",fairytale
+      s = selector('Choose a fairy tale',fairytale)
+      print "(a)","returned: ",s
+      if (s == "") print "(a)","(an empty string)"
+
+      end program menu_demo