Imported Upstream version 4.8.1
[platform/upstream/gcc48.git] / gcc / testsuite / gfortran.dg / g77 / 980419-2.f
1 c { dg-do compile }
2 c { dg-options "-std=legacy" }
3 c
4 c     SEGVs in loop.c with -O2.
5
6       character*80 function nxtlin(lun,ierr,itok)
7       character onechr*1,twochr*2,thrchr*3
8       itok=0
9       do while (.true.)
10          read (lun,'(a)',iostat=ierr) nxtlin
11          if (nxtlin(1:1).ne.'#') then
12             ito=0
13             do 10 it=1,79
14                if (nxtlin(it:it).ne.' ' .and. nxtlin(it+1:it+1).eq.' ')
15      $              then
16                   itast=0
17                   itstrt=0
18                   do itt=ito+1,it
19                      if (nxtlin(itt:itt).eq.'*') itast=itt
20                   enddo
21                   itstrt=ito+1
22                   do while (nxtlin(itstrt:itstrt).eq.' ')
23                      itstrt=itstrt+1
24                   enddo
25                   if (itast.gt.0) then
26                      nchrs=itast-itstrt
27                      if (nchrs.eq.1) then
28                         onechr=nxtlin(itstrt:itstrt)
29                         read (onechr,*) itokn
30                      elseif (nchrs.eq.2) then
31                         twochr=nxtlin(itstrt:itstrt+1)
32                         read (twochr,*) itokn
33                      elseif (nchrs.eq.3) then
34                         thrchr=nxtlin(itstrt:itstrt+2)
35                         read (thrchr,*) itokn
36                      elseif (nchrs.eq.4) then
37                         thrchr=nxtlin(itstrt:itstrt+3)
38                         read (thrchr,*) itokn
39                      endif
40                      itok=itok+itokn
41                   else
42                      itok=itok+1
43                   endif
44                   ito=it+1
45                endif
46  10         continue
47             return
48          endif
49       enddo
50       return
51       end