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