1* Date: Wed, 25 Jun 1997 12:48:26 +0200 (MET DST)
2* MIME-Version: 1.0
3* From: R.Hooft@EuroMail.com (Rob Hooft)
4* To: g77-alpha@gnu.ai.mit.edu
5* Subject: Re: testing 970624.
6* In-Reply-To: <199706251027.GAA07892@churchy.gnu.ai.mit.edu>
7* References: <199706251018.MAA21538@nu>
8* <199706251027.GAA07892@churchy.gnu.ai.mit.edu>
9* X-Mailer: VM 6.30 under Emacs 19.34.1
10* Content-Type: text/plain; charset=US-ASCII
11*
12* >>>>> "CB" == Craig Burley <burley@gnu.ai.mit.edu> writes:
13*
14*  CB> but OTOH I'd like to see more problems like this on other
15*  CB> applications, and especially other systems
16*
17* How about this one: An application that prints "112." on all
18* compilers/platforms I have tested, except with the new g77 on ALPHA (I
19* don't have the new g77 on any other platform here to test)?
20*
21* Application Appended. Source code courtesy of my boss.....
22* Disclaimer: I do not know the right answer, or even whether there is a
23* single right answer.....
24*
25* Regards,
26* --
27* ===== R.Hooft@EuroMail.com   http://www.Sander.EMBL-Heidelberg.DE/rob/ ==
28* ==== In need of protein modeling?  http://www.Sander.EMBL-Heidelberg.DE/whatif/
29* Validation of protein structures?  http://biotech.EMBL-Heidelberg.DE:8400/ ====
30* == PGPid 0xFA19277D == Use Linux!  Free Software Rules The World! =============
31*
32* nu[152]for% cat humor.f
33      PROGRAM SUBROUTINE
34      LOGICAL ELSE IF
35      INTEGER REAL, GO TO PROGRAM, WHILE, THEN, END DO
36      REAL FORMAT(2)
37      DATA IF,REAL,END DO,WHILE,FORMAT(2),I2/2,6,7,1,112.,1/
38      DO THEN=1, END DO, WHILE
39         CALL = END DO - IF
40         PROGRAM = THEN - IF
41         ELSE IF = THEN .GT. IF
42         IF (THEN.GT.REAL) THEN
43            CALL FUNCTION PROGRAM (ELSE IF, GO TO PROGRAM, THEN) ! { dg-error "Type mismatch in argument" }
44         ELSE IF (ELSE IF) THEN
45            REAL = THEN + END DO
46         END IF
47      END DO
48 10   FORMAT(I2/I2) = WHILE*REAL*THEN
49      IF (FORMAT(I2) .NE. FORMAT(I2+I2)) CALL ABORT
50      END ! DO
51      SUBROUTINE FUNCTION PROGRAM (REAL,INTEGER, LOGICAL)
52      LOGICAL REAL
53      REAL LOGICAL
54      INTEGER INTEGER, STOP, RETURN, GO TO
55      ASSIGN 9 TO STOP     ! { dg-warning "ASSIGN" "" }
56      ASSIGN = 9 + LOGICAL
57      ASSIGN 7 TO RETURN   ! { dg-warning "ASSIGN" "" }
58      ASSIGN 9 TO GO TO    ! { dg-warning "ASSIGN" "" }
59      GO TO = 5
60      STOP = 8
61      IF (.NOT.REAL) GOTO STOP ! { dg-warning "Assigned GOTO" "" }
62      IF (LOGICAL.GT.INTEGER) THEN
63         IF = LOGICAL +5
64         IF (LOGICAL.EQ.5) ASSIGN 5 TO IF ! { dg-warning "ASSIGN" "" }
65         INTEGER=IF
66      ELSE
67         IF (ASSIGN.GT.STOP) ASSIGN 9 TO GOTO ! { dg-warning "ASSIGN" "" }
68         ELSE = GO TO
69         END IF = ELSE + GO TO
70         IF (.NOT.REAL.AND.GOTO.GT.ELSE) GOTO RETURN ! { dg-warning "Assigned GOTO" "" }
71      END IF
72    5 CONTINUE
73    7 LOGICAL=LOGICAL+STOP
74    9 RETURN
75      END ! IF
76* nu[153]for% f77 humor.f
77* nu[154]for% ./a.out
78*    112.0000
79* nu[155]for% f90 humor.f
80* nu[156]for% ./a.out
81*    112.0000
82* nu[157]for% g77 humor.f
83* nu[158]for% ./a.out
84*   40.
85