CodeSOD: I (fort)RAN So Far Away
Many years ago, Matt left a position where he developed in FORTRAN, and went off to do other things. The company hired a replacement, and since no one else really understood FORTRAN, they assumed things were fine. Over the course of a decade, their development costs got more expensive, their software got buggier, and deadlines started flying by without a single new feature being released. It took a long time, but they eventually fired Matt's replacement. Since Matt was looking for a new position around that time, he ended up back in the FORTRAN shop: just when he thought he was out, they pulled him back in.
Matt started going through the code that'd been implemented, and... well, here's an example function signature:
SUBROUTINE TREND_ORA_GET (AASTAT, DATATYPE, ORA_CODE > , MON, YEAR, IN_OPTION, OUT_ARRAY)
Now, if you're reading this, you might think OUT_ARRAY is an output parameter. You'd be mistaken. It's just the name of an array which happens to be defined in Common (which is Fortran's term for global variables).
Inside this subroutine, the code starts by fetching some data from a database, and then starts doing things like:
IF (OUT_ARRAY(1:1) .EQ. 'G') THEN IF (OUT_ARRAY .EQ. 'GRP ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. max_results) THEN GRP (RNUM) = TBLDATA (I) ENDIF! IF (RNUM .LT.10) THEN! WRITE (*,*) 'GRP(RNUM) = ',GRP(RNUM),TBLDATA(I)! ENDIF ENDDO ENDIF ENDIF
The first line, there, accesses the first element of the array, and compares it to G- it's a "starts with" check. If it starts with G, then we check if the array is equal to GRP . Why the extra starts with? My only guess is that it's a micro-optimization to minimize the linear search on string comparisons.
If the array is GRP , then we loop from 1 to NID, and pull data out of the TBLITEMS collection, collecting them into a GRP collection. Why? I have no idea. The lines marked wit h! are comments.
But we do this many, many more times, complete with the optimization(?) of checking the first character in OUT_ARRAY.
IF (OUT_ARRAY(1:1) .EQ. 'M') THEN IF (OUT_ARRAY .EQ. 'M6R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN M6R (RNUM) = TBLDATA (I) ENDIF IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN M6R (RNUM) = TBLDATA (I)! WRITE (*,*) 'M6R(RNUM) = ',M6R(RNUM),'RNUM = ',RNUM,TBLDATA(I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'M5R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN M5R (RNUM) = TBLDATA (I) ENDIF IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN M5R (RNUM) = TBLDATA (I)! WRITE (*,*) 'M5R(RNUM) = ',M5R(RNUM),'RNUM = ',RNUM,TBLDATA(I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'M4R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN M4R (RNUM) = TBLDATA (I) ENDIF IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN M4R (RNUM) = TBLDATA (I)! WRITE (*,*) 'M4R(RNUM) = ',M6R(RNUM),'RNUM = ',RNUM,TBLDATA(I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'M3R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN M3R (RNUM) = TBLDATA (I) ENDIF IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN M3R (RNUM) = TBLDATA (I)! WRITE (*,*) 'M3R(RNUM) = ',M3R(RNUM),'RNUM = ',RNUM,TBLDATA(I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'M2R ') THEN! write (*,*)'NID = ', nid DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN M2R (RNUM) = TBLDATA (I) ENDIF! If (tblitems (i) .gt. 60000) then! write(*,*) 'tblitems(i) = ',tblitems(i), 'I = ',i! endif IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN M2R (RNUM) = TBLDATA (I)! WRITE (*,*) 'M2R(RNUM) = ',M2R(RNUM),'RNUM = ',RNUM,TBLDATA(I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'M1R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN M1R (RNUM) = TBLDATA (I) ENDIF IF ((RNUM .EQ. 43357) .OR. (RNUM .EQ.43358)) THEN M1R (RNUM) = TBLDATA (I)! WRITE (*,*) 'M1R(RNUM) = ',M1R(RNUM),'RNUM = ',RNUM,TBLDATA(I) ENDIF ENDDO ENDIF ENDIF IF (OUT_ARRAY(1:1) .EQ. 'Y') THEN IF (OUT_ARRAY .EQ. 'Y1R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN Y1R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'Y2R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN Y2R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'Y5R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN Y5R (RNUM) = TBLDATA (I) ENDIF ENDDO ENDIF ENDIF IF (OUT_ARRAY(1:1) .EQ. 'R') THEN IF (OUT_ARRAY .EQ. 'R6R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN R6R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'R5R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN R5R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'R4R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN R4R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'R3R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN R3R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'R2R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN R2R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'R1R ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN R1R (RNUM) = TBLDATA (I) ENDIF ENDDO ENDIF ENDIF IF (OUT_ARRAY(2:2) .EQ. 'Y') THEN IF (OUT_ARRAY .EQ. 'PY5R') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN PY5R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'ZY1R') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN ZY1R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'RY1R') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN RY1R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'RY5R') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN RY5R (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'RY6R') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF ((RNUM .GE. 15722) .AND. (RNUM .LE.15727)) THEN RY6R (RNUM) = TBLDATA (I)! WRITE (*,*) 'RY6R(RNUM) = ',RY6R(RNUM),'RNUM = ',RNUM,TBLDATA(I) ENDIF IF ((RNUM .GE. 41708) .AND. (RNUM .LE.41759)) THEN RY6R (RNUM) = TBLDATA (I)! WRITE (*,*) 'RY6R(RNUM) = ',RY6R(RNUM),'RNUM = ',RNUM,TBLDATA(I) ENDIF ENDDO ENDIF ENDIF IF (OUT_ARRAY .EQ. 'TOT ') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN TOT (RNUM) = TBLDATA (I) ENDIF ENDDO ELSE IF (OUT_ARRAY .EQ. 'RTOT') THEN DO I = 1, NID RNUM = TBLITEMS (I) IF (RNUM .LE. MAX_RESULTS) THEN RTOT (RNUM) = TBLDATA (I) ENDIF ENDDO ENDIF
I love this code sample, because I don't know Fortran, and it's still easy to see that this code is bad. It's repetitive, it's cryptic, and it's obviously fragile and difficult to modify. Matt adds:
The real WTF is, of course, that we're still using FORTRAN. That's because the customer still insists on their reports being produced on fan-feed line-printer (chunka-chunka-chunka) paper 122-columns wide etc. etc.
[Advertisement] Utilize BuildMaster to release your software with confidence, at the pace your business demands. Download today!