gcc/testsuite/g77.dg/strlen0.f

   1 C     Substring range checking test program, to check behavior with respect
   2 C     to X3J3/90.4 paragraph 5.7.1.
   3 C
   4 C     Patches relax substring checking for subscript expressions in order to
   5 C     simplify coding (elimination of length checks for strings passed as
   6 C     parameters) and to avoid contradictory behavior of subscripted substring
   7 C     expressions with respect to unsubscripted string expressions.
   8 C
   9 C     Key part of 5.7.1 interpretation comes down to statement that in the
  10 C     substring expression,
  11 C        v ( e1 : e2 )
  12 C     1 <= e1 <= e2 <= len to be valid, yet the expression
  13 C        v ( : )
  14 C     is equivalent to
  15 C        v(1:len(v))
  16 C
  17 C     meaning that any statement that reads
  18 C        str = v // 'tail'
  19 C     (where v is a string passed as a parameter) would require coding as
  20 C        if (len(v) .gt. 0) then
  21 C           str = v // 'tail'
  22 C        else
  23 C           str = 'tail'
  24 C        endif
  25 C     to comply with the standard specification.  Under the stricter
  26 C     interpretation, functions strcat and strlat would be incorrect as
  27 C     written for null values of str1 and/or str2.
  28 C
  29 C     This code compiles and runs without error on
  30 C       SunOS 4.1.3 f77 (-C option)
  31 C       SUNWspro SPARCcompiler 4.2 f77 (-C option)
  32 C       (and with proposed patches, gcc-2.9.2 -fbounds-check except for test 6,
  33 C        which is a genuine, deliberate error - comment out to make further
  34 C        tests)
  35 C
  36 C { dg-do run }
  37 C { dg-options "-fbounds-check" }
  38 C
  39 C     G. Helffrich/Tokyo Inst. Technology Jul 24 2001
  40
  41       character str*8,strres*16,strfun*16,strcat*16,strlat*16
  42
  43       str='Hi there'
  44
  45 C     Test 1 - (current+patched) two char substring result
  46       strres=strfun(str,1,2)
  47       write(*,*) 'strres is ',strres
  48
  49 C     Test 2 - (current+patched) null string result
  50       strres=strfun(str,5,4)
  51       write(*,*) 'strres is ',strres
  52
  53 C     Test 3 - (current+patched) null string result
  54       strres=strfun(str,8,7)
  55       write(*,*) 'strres is ',strres
  56
  57 C     Test 4 - (current) error; (patched) null string result
  58       strres=strfun(str,9,8)
  59       write(*,*) 'strres is ',strres
  60
  61 C     Test 5 - (current) error; (patched) null string result
  62       strres=strfun(str,1,0)
  63       write(*,*) 'strres is ',strres
  64
  65 C     Test 6 - (current+patched) error
  66 C     strres=strfun(str,20,20)
  67 C     write(*,*) 'strres is ',strres
  68
  69 C     Test 7 - (current+patched) str result
  70       strres=strcat(str,'')
  71       write(*,*) 'strres is ',strres
  72
  73 C     Test 8 - (current) error; (patched) str result
  74       strres=strlat('',str)
  75       write(*,*) 'strres is ',strres
  76
  77       end
  78
  79       character*(*) function strfun(str,i,j)
  80       character str*(*)
  81
  82       strfun = str(i:j)
  83       end
  84
  85       character*(*) function strcat(str1,str2)
  86       character str1*(*), str2*(*)
  87
  88       strcat = str1 // str2
  89       end
  90
  91       character*(*) function strlat(str1,str2)
  92       character str1*(*), str2*(*)
  93
  94       strlat = str1(1:len(str1)) // str2(1:len(str2))
  95       end