Update copyright to LGPL on all files
[dyninst.git] / testsuite / src / dyninst / test1_7F_fortran.F
1  !
2  ! Copyright (c) 1996-2009 Barton P. Miller
3  ! 
4  ! We provide the Paradyn Parallel Performance Tools (below
5  ! described as "Paradyn") on an AS IS basis, and do not warrant its
6  ! validity or performance.  We reserve the right to update, modify,
7  ! or discontinue this software at any time.  We shall have no
8  ! obligation to supply such updates or modifications or any other
9  ! form of support to you.
10  ! 
11  ! By your use of Paradyn, you understand and agree that we (or any
12  ! other person or entity with proprietary rights in Paradyn) are
13  ! under no obligation to provide either maintenance services,
14  ! update services, notices of latent defects, or correction of
15  ! defects for Paradyn.
16  ! 
17  ! This library is free software; you can redistribute it and/or
18  ! modify it under the terms of the GNU Lesser General Public
19  ! License as published by the Free Software Foundation; either
20  ! version 2.1 of the License, or (at your option) any later version.
21  ! 
22  ! This library is distributed in the hope that it will be useful,
23  ! but WITHOUT ANY WARRANTY; without even the implied warranty of
24  ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
25  ! Lesser General Public License for more details.
26  ! 
27  ! You should have received a copy of the GNU Lesser General Public
28  ! License along with this library; if not, write to the Free Software
29  ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
30  !
31
32 ! libdyninst validation suite test #1
33 ! author: Jon Beyer (6/1/01)
34 !       derived from a previous test by Jeff Hollingsworth
35
36 !------------------------------------------------------------------------------
37
38 ! AIX xlf90 does not insert underscores at end
39
40 #if !defined(XLF)
41 #define stop_process_ stop_process
42 #endif
43
44 #ifdef __GNUC__
45 #define AND iand
46 #define OR ior
47 #else
48 #define AND and
49 #define OR or
50 #endif
51
52 !------------------------------------------------------------------------------
53
54         SUBROUTINE test1_7f_init_globals
55 #include "test1_7F_common.h"
56
57         test1_7_constVar0 = 0
58         test1_7_constVar1 = 1
59         test1_7_constVar2 = 2
60         test1_7_constVar3 = 3
61         test1_7_constVar4 = 4
62         test1_7_constVar5 = 5
63         test1_7_constVar6 = 6
64         test1_7_constVar7 = 7
65         test1_7_constVar9 = 9
66
67         test1_7_globalVariable1 = 71
68         test1_7_globalVariable2 = 71
69         test1_7_globalVariable3 = 71
70         test1_7_globalVariable4 = 71
71         test1_7_globalVariable5 = 71
72         test1_7_globalVariable6 = 71
73         test1_7_globalVariable7 = 71
74         test1_7_globalVariable8 = 71
75         test1_7_globalVariable9 = 71
76         test1_7_globalVariable10 = 71
77         test1_7_globalVariable11 = 71
78         test1_7_globalVariable12 = 71
79         test1_7_globalVariable13 = 71
80         test1_7_globalVariable14 = 71
81         test1_7_globalVariable15 = 71
82         test1_7_globalVariable16 = 71
83
84         test1_7_globalVariable1a = 73
85         test1_7_globalVariable2a = 73
86         test1_7_globalVariable3a = 73
87         test1_7_globalVariable4a = 73
88         test1_7_globalVariable5a = 73
89         test1_7_globalVariable6a = 73
90         test1_7_globalVariable7a = 73
91         test1_7_globalVariable8a = 73
92         test1_7_globalVariable9a = 73
93         test1_7_globalVariable10a = 73
94         test1_7_globalVariable11a = 73
95         test1_7_globalVariable12a = 73
96         test1_7_globalVariable13a = 73
97         test1_7_globalVariable14a = 73
98         test1_7_globalVariable15a = 73
99         test1_7_globalVariable16a = 73
100
101         END
102
103 !------------------------------------------------------------------------------
104
105         SUBROUTINE fail7Print (tCase, fCase, op)
106         INTEGER tCase
107         INTEGER fCase
108         CHARACTER op *(*)
109
110         if (tCase .ne. 72) then
111                 print *, ' operator ', op, ' was not true when it should be',
112      & ' - const expr'
113         endif
114         if (fCase .ne. 71) then
115                 print *, ' operator ', op, ' was not false when it should be',
116      & ' - const expr'
117         endif
118         END
119
120 !------------------------------------------------------------------------------
121
122         SUBROUTINE fail7aPrint (tCase, fCase, op)
123         INTEGER tCase
124         INTEGER fCase
125         CHARACTER op *(*)
126
127         if (tCase .ne. 74) then
128                 print *, ' operator ', op, ' was not true when it should be',
129      & ' - var expr'
130         endif
131         if (fCase .ne. 73) then
132                 print *, ' operator ', op, ' was not false when it should be',
133      & ' - var expr'
134         endif
135         END
136
137 !------------------------------------------------------------------------------
138
139         SUBROUTINE test1_7_func1
140 #include "test1_7F_common.h"
141
142         CALL test1_7_func2
143
144         if (test1_7_globalVariable1 .eq. 72 .and.
145      & test1_7_globalVariable2 .eq. 71 .and.
146      & test1_7_globalVariable3 .eq. 72 .and.
147      & test1_7_globalVariable4 .eq. 71 .and.
148      & test1_7_globalVariable5 .eq. 72 .and.
149      & test1_7_globalVariable6 .eq. 71 .and.
150      & test1_7_globalVariable7 .eq. 72 .and.
151      & test1_7_globalVariable8 .eq. 71 .and.
152      & test1_7_globalVariable9 .eq. 72 .and.
153      & test1_7_globalVariable10 .eq. 71 .and.
154      & test1_7_globalVariable11 .eq. 72 .and.
155      & test1_7_globalVariable12 .eq. 71 .and.
156      & test1_7_globalVariable13 .eq. 72 .and.
157      & test1_7_globalVariable14 .eq. 71 .and.
158      & test1_7_globalVariable15 .eq. 72 .and.
159      & test1_7_globalVariable16 .eq. 71 .and.
160      & test1_7_globalVariable1a .eq. 74 .and.
161      & test1_7_globalVariable2a .eq. 73 .and.
162      & test1_7_globalVariable3a .eq. 74 .and.
163      & test1_7_globalVariable4a .eq. 73 .and.
164      & test1_7_globalVariable5a .eq. 74 .and.
165      & test1_7_globalVariable6a .eq. 73 .and.
166      & test1_7_globalVariable7a .eq. 74 .and.
167      & test1_7_globalVariable8a .eq. 73 .and.
168      & test1_7_globalVariable9a .eq. 74 .and.
169      & test1_7_globalVariable10a .eq. 73 .and.
170      & test1_7_globalVariable11a .eq. 74 .and.
171      & test1_7_globalVariable12a .eq. 73 .and.
172      & test1_7_globalVariable13a .eq. 74 .and.
173      & test1_7_globalVariable14a .eq. 73 .and.
174      & test1_7_globalVariable15a .eq. 74 .and.
175      & test1_7_globalVariable16a .eq. 73) then
176                 passedTest = 1
177         else
178                 print *, '**Failed** test #7 (relational operators)'
179                 CALL fail7Print(test1_7_globalVariable1, test1_7_globalVariable2,
180      & "BPatch_lt")
181                 CALL fail7Print(test1_7_globalVariable3, test1_7_globalVariable4,
182      & "BPatch_eq")
183                 CALL fail7Print(test1_7_globalVariable5, test1_7_globalVariable6,
184      & "BPatch_gt")
185                 CALL fail7Print(test1_7_globalVariable7, test1_7_globalVariable8,
186      & "BPatch_le")
187                 CALL fail7Print(test1_7_globalVariable9, test1_7_globalVariable10,
188      & "BPatch_ne")
189                 CALL fail7Print(test1_7_globalVariable11, test1_7_globalVariable12,
190      & "BPatch_ge")
191                 CALL fail7Print(test1_7_globalVariable13, test1_7_globalVariable14,
192      & "BPatch_and")
193                 CALL fail7Print(test1_7_globalVariable15, test1_7_globalVariable16,
194      & "BPatch_or")
195
196                 CALL fail7aPrint(test1_7_globalVariable1a, test1_7_globalVariable2a,
197      & "BPatch_lt")
198                 CALL fail7aPrint(test1_7_globalVariable3a, test1_7_globalVariable4a,
199      & "BPatch_eq")
200                 CALL fail7aPrint(test1_7_globalVariable5a, test1_7_globalVariable6a,
201      & "BPatch_gt")
202                 CALL fail7aPrint(test1_7_globalVariable7a, test1_7_globalVariable8a,
203      & "BPatch_le")
204                 CALL fail7aPrint(test1_7_globalVariable9a, test1_7_globalVariable10a,
205      & "BPatch_ne")
206                 CALL fail7aPrint(test1_7_globalVariable11a, test1_7_globalVariable12a,
207      & "BPatch_ge")
208                 CALL fail7aPrint(test1_7_globalVariable13a, test1_7_globalVariable14a,
209      & "BPatch_and")
210                 CALL fail7aPrint(test1_7_globalVariable15a, test1_7_globalVariable16a,
211      & "BPatch_or")
212         endif
213         END
214
215 !------------------------------------------------------------------------------
216
217         SUBROUTINE test1_7_func2
218         INTEGER foo = 0
219         END
220
221 !------------------------------------------------------------------------------