C  Strtest - Perform some basic tests of the functionality of the
C  string passing to and from the PAPI Fortran interface. 
C
C    Test 1: Look up an event name from an event code. Use this name
C            to try and locate the event code using the name received.
C            Long, short and too short strings are used in the tests
C
C    Test 2: Look up a PAPI error string. Use long, short and too 
C            short strings to store the result.
C
C    Test 3: Look up and display event descriptions 
C            using PAPIf_get_event_info.
C
C    Comments:
C    When using the Fortran interface it may not always be possible to
C    use the PAPI predefined constants as actual arguments. Due to the
C    values in these compilers might occasionally cast these into the
C    wrong type. In the code below the line code=MSGCODE is used to 
C    make sure that the event code get the right type.
C
#include "fpapi_test.h"
C Set MSGLEN to the number of characters in the named event in MSGCODE
#define MSGLEN 11
#define MSGCODE PAPI_L1_DCM 
#define ERRCODE PAPI_EINVAL
       
      program strtest
      implicit integer (p)
      
      CHARACTER*(PAPI_MAX_STR_LEN) papistr
      CHARACTER*(PAPI_MAX_STR_LEN*2) papidblstr

      CHARACTER*(PAPI_MAX_STR_LEN) ckstr
      CHARACTER*(MSGLEN) invstr1
      CHARACTER*(MSGLEN+1) invstr2
      CHARACTER*(MSGLEN+2) invstr3
      CHARACTER*(MSGLEN-1) invstr4
      CHARACTER*(MSGLEN-2) invstr5

      integer check,lastchar
      integer code,papicode
      integer getstrlen
      external getstrlen
      integer tests_quiet, get_quiet
      external get_quiet

      tests_quiet = get_quiet()

      check=PAPI_VER_CURRENT
      call PAPIF_library_init(check)
      if ( check.NE.PAPI_VER_CURRENT) then
           call PAPIF_perror( 'PAPI_library_init' )
        call ftest_fail(__FILE__, __LINE__,
     . 'PAPI_library_init', check)
      end if

      code=MSGCODE

      if (tests_quiet .EQ. 0) then
         print *,'---------------------------------------------------'
         print *,'   Testing PAPIF_name_to_code/PAPIF_code_to_name   '
         print *,'---------------------------------------------------'
         print *,' These tests look up an event name and event code'
         print *,' On no occasion should a NULL character be found(+)'
         print *,' When strings are too short, the lookup should fail'
         print *
         print *,' Tests use the event code ',code
         print *
       end if

      lastchar=PAPI_MAX_STR_LEN
      call checkstr(code,ckstr,check,lastchar,tests_quiet)
      lastchar=getstrlen(ckstr)
 
      call checkstr(code,invstr1,check,lastchar,tests_quiet)

      call checkstr(code,invstr2,check,lastchar,tests_quiet)

      call checkstr(code,invstr3,check,lastchar,tests_quiet)

      call checkstr(code,invstr4,check,lastchar,tests_quiet)

      call checkstr(code,invstr5,check,lastchar,tests_quiet)

      if (tests_quiet .EQ. 0) then
         print *,'---------------------------------------------------'
         print *,'          Testing PAPIF_descr_event                '
         print *,'---------------------------------------------------'
         print *,' These tests should return a PAPI description for'
         print *,' various event names and argument shapes.'
         print *,' On no occasion should a NULL character be found(+)'
         print *

         print 200,'Test 1'
      end if

      papistr="  "
      papicode=PAPI_L1_DCM
      call test_papif_descr(papistr,papicode,papidblstr,
     .  check,tests_quiet)
      call checkcode(papicode,PAPI_L1_DCM,tests_quiet)

      if (tests_quiet .EQ. 0) then
         print *
         print 200,'Test 2'
      end if

      papistr="  "
      papicode=PAPI_L2_DCM
      call test_papif_descr(papistr,papicode,papidblstr,
     .  check,tests_quiet)
      call checkname(papistr,"PAPI_L2_DCM",tests_quiet)

      if (tests_quiet .EQ. 0) then
         print *
         print 200,'Test 3'
      end if

      invstr1="  "
      papicode=PAPI_L1_ICM
      call test_papif_descr(invstr1,papicode,papidblstr,
     .  check,tests_quiet)
      call checkcode(papicode,PAPI_L1_ICM,tests_quiet)

      if (tests_quiet .EQ. 0) then
          print *
          print 200,'Test 4'
      end if

      invstr1="  "
      papicode=PAPI_L2_ICM
      call test_papif_descr(invstr1,papicode,papidblstr,
     .  check,tests_quiet)
      call checkname(invstr1,"PAPI_L2_ICM",tests_quiet)

      if (tests_quiet .EQ. 0) then
         print *
         print 200,'Test 5  (This should get a truncated description)'
      end if

      invstr2="  "
      papicode=PAPI_L3_DCM
      call test_papif_descr(invstr2,papicode,invstr1,
     .  check,tests_quiet)
      call checkcode(papicode,PAPI_L3_DCM,tests_quiet)

      if (tests_quiet .EQ. 0) then
         print *
         print 200,'Test 6  (This should get a truncated description)'
      end if

      invstr2="  "
      papicode=PAPI_L3_ICM
      call test_papif_descr(invstr2,papicode,invstr1,
     .  check,tests_quiet)
      call checkname(invstr2,"PAPI_L3_ICM",tests_quiet)

      if (tests_quiet .EQ. 0) then
         print *
         print 200,'Test 7  (This should get a truncated name)'
      end if

      invstr4="  "
      papicode=PAPI_L1_DCM
      call test_papif_descr(invstr4,papicode,papistr,
     .  check,tests_quiet)
      if (tests_quiet .EQ. 0) then
         call checkname(invstr4,"PAPI_L1_DCM",tests_quiet)
      end if

 200  format(t1,a)

      if (tests_quiet .EQ. 0) then
         print *,'---------------------------------------------------'
         print *,'(+) Fortran implementations that do not provide the'
         print *,'    string argument length might show NULL '//
     .           'characters.'
         print *,'    This may or may not be OK depending on the '//
     .           'Fortran'
         print *,'    compiler. See papi_fwrappers.c and your Fortran'
         print *,'    compiler reference manual.'
      end if

      call ftests_pass(__FILE__)      
      end

      subroutine checkstr(incode,string,check,lastchar,quiet)
      implicit integer (P)
      integer incode
      integer check,lastchar, quiet
      character*(*) string
      integer code
      integer getstrlen
      external getstrlen

 100  format(t1,a,i4)

      if (quiet .EQ. 0) then
         print 100,"Testing string length ",len(string)
         if(len(string).lt.lastchar)then
            print *,'This call should return an error code.'
         end if
      end if

      code=incode
      call PAPIF_event_code_to_name(code,string,check)
      if(check.ne.PAPI_OK)then
        if (len(string).ge.lastchar)then
          call ftest_fail(__FILE__, __LINE__,
     . 'PAPIF_event_code_to_name', check)
        else
        if (quiet .EQ. 0) then
           call PAPIF_perror( 'PAPIF_event_code_to_name' )
           print *,'*ERROR* '
           print *,'******* '//'Error in checkstr using '//
     $ 'PAPIF_event_code_to_name'
        end if
       end if
      end if

 200  format(t1,a,'"',a,'"')
      if (quiet .EQ. 0) then
         print 200,'The event name is: ',string(1:getstrlen(string))
      end if

      call PAPIF_event_name_to_code(string,code,check)
      if(check.ne.PAPI_OK)then
      if (len(string).ge.lastchar)then
          call ftest_fail(__FILE__, __LINE__,
     . 'PAPIF_event_name_to_code', check)
      else
      if (quiet .EQ. 0) then
         call PAPIF_perror( 'PAPIF_event_name_to_code' )
         print *,'*ERROR* '
         print *,'******* '//'Error in checkstr using '//
     $   'PAPIF_event_name_to_code'
      end if
      end if
      end if
      
      call findnull(string,quiet)

      if (quiet .EQ. 0) then
         print *
      end if

      return
      end

      subroutine test_papif_descr(name,code,string,check,quiet)
      implicit integer (P)
      integer code,count,flags
      integer check,quiet
      character*(*) name,string

      character*(PAPI_MAX_STR_LEN) label,note
      integer getstrlen
      external getstrlen

C      This API was deprecated with PAPI 3
C      call PAPIF_describe_event(name,code,string,check)
      call PAPIF_get_event_info(code,name,string,label,count,
     $     note,flags,check)
 100  format(t1,a,'"',a,'"')
      if (quiet .EQ. 0) then
        print 100,'The event description is: ',
     $    string(1:getstrlen(string))
      end if

      if(check.ne.PAPI_OK)then
      if (quiet .EQ. 0) then
          call PAPIF_perror( 'PAPI_get_event_info' )
          print *,'*ERROR* '
          print *,'******* '//'Error in test_papif_descr using '//
     $      'PAPIF_get_event_info'
      else
          call ftest_fail(__FILE__, __LINE__,
     . 'PAPIF_get_event_info', check)
        end if
      end if

      call findnull(string,quiet)
      call findnull(name,quiet)

      return
      end

      integer function getstrlen(string)
      implicit integer (P)
      character*(*) string
      integer i

      do i=len(string),1,-1
        if(string(i:i).ne.' ') then 
          goto 20
        end if
      end do
      getstrlen=0
      return

 20   continue
      getstrlen=i
      return
      end

      subroutine findnull(string,quiet)
      implicit integer (P)
      integer quiet,i
      character*(*) string

      i=index(string,char(0))
      if(i.gt.0)then
        if(quiet.EQ.0)then
           print *,'NULL character found in string!!!'
        else
            call ftest_fail(__FILE__, __LINE__,
     . 'NULL character found in string!!!', 0)
        end if
      end if

      return
      end


      subroutine checkcode(code,check,quiet)
      implicit integer (P)
      integer code
      integer check,quiet

      if(code.ne.check)then
      if(quiet.EQ.0)then
         print 100,'Code look up failed?'
      else
          call ftest_fail(__FILE__, __LINE__,
     .   'Code look up failed?', 0)
        end if
      end if
 100  format(t2,a)

      return
      end

      subroutine checkname(name,check,quiet)
      implicit integer (P)
      character*(*) name
      character*(*) check
      integer i,quiet
      integer getstrlen

      i=getstrlen(name)
      if(name(1:i).ne.check)then
        if (quiet .eq. 0) then
           print 100,'PAPI name incorrect?'
           print 110,'Got:      ',name(1:i)
           print 110,'Expected: ',check
        else
          call ftest_fail(__FILE__, __LINE__,
     .  'PAPI name incorrect?', 0)
        end if
      end if

 100  format(t2,a)
 110  format(a12,'"',a,'"')

      return
      end