home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / fchek284.zip / test / usage.f < prev   
Text File  |  1994-11-06  |  2KB  |  90 lines
  1.     program yacctest
  2. c
  3. c  Tests the Yacc fortran parser.
  4. *  Should pass the current version.
  5. C  It is also a legal, though not especially meaningful, program
  6. *
  7.     implicit integer (u-z)
  8.     dimension xyz(3),abc
  9. c  The next line has some whitespace, but nothing else.  Note continuation!!
  10.                        
  11.      $         (9,9,100)
  12. 22    equivalence (a,b) , (xyz,abc,def)
  13.     intrinsic sqrt,log
  14. c
  15.     common com1,com2 /blk1/ com3,com4(5),com6, /blk2/ w123x
  16.  
  17.     common comm1,comm2 /blk3/ comm3,comm4(5),comm6 /blk4/ cc1
  18.  
  19.     implicit double precision (d), real(r)
  20.     integer program(3,3), pause(20)
  21.          character *8 bb,bb13*3
  22.     character *4, cc(9),cc1
  23.     parameter (Pi = 3.14159265358979D0)
  24.  
  25.     logical stop, save
  26.     equivalence (xyz(1),qq), (bb(1:3),bb13)
  27.      x    ,    (cc1,bb)
  28.     real a123(9,9), ifa
  29.     integer xray
  30.     external xray
  31.     double precision dbl1,dbl2(3)
  32.     logical test
  33.     complex compl1,compl2
  34.     test = .true.
  35.     data ( (a123(i,j),i=1,9),j=1,9) ,ifa / 82*0.0 /
  36.     data cc / 9*'help' /, bb /'wouldn''t'/ com4 / -1e7,+5.2
  37.      $,                    4habcd, .1, 1. /
  38.     if(dbl1) 10,34567,5432
  39. 34567    stop
  40. 10    stop 123
  41. 5432    pause
  42.     end = 123 + pause(1)
  43.     read(iunit,*) (((abc(i,j,k),k=1,100),j=1,9),i=1,9),xyz(2)
  44.     read iunit , a,b,xyz(1)
  45.     write(iunit,*) 'hello there',a
  46.     print *, cc(1),a+b*Pi
  47.     print 5, (cc(i),i=1,4)
  48.     if( stop .and. save ) then
  49.         cc(2) = 'abcd'
  50.         www = 4.7 + (Pi * 2)**8
  51.     else if(abc(1,1,1) .eq. xyz(2)) then
  52.         open(unit=4,file='foo.bar',err=5432,status='old')
  53.         rewind 1+3
  54.         close(4)
  55.         open(3,file='buzzsaw',form='unformatted',status='new')
  56.         backspace (unit=3)
  57.         close(unit=3)
  58.     endif
  59.     test = .false.
  60.     dbl1 = 1.2345
  61.     write (6,900) dbl1
  62. 900    format(f10.2)
  63.     if(test) goto 10
  64.     pause 456
  65.     goto 34567
  66.     end
  67.  
  68. c comments in here don't hurt a bit
  69.  
  70.     integer function xray(beta,gamma)
  71.     character *(*) gamma
  72. *
  73.  
  74.     logical beta
  75.     if( beta ) xray = 1.0D0
  76.     end
  77.  
  78.     subroutine home(x,*)
  79.     common /blk1/ com3,com4(5),com6
  80.     save /blk1/,xray
  81.     if((x-1.0)**(sqrt(2.0))/(5/4+com6) .gt. com3) then
  82.         xray = 1.234
  83.         return
  84.     else
  85.         xray = -1.234 ** (+1.7e10)
  86.     endif
  87.     com4(com2+com6) = com4(xray)
  88.     return 1
  89.     end
  90.