Update copyright to LGPL on all files
[dyninst.git] / testsuite / src / dyninst / test1_26F_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_26f_init_globals
55 #include "test1_26F_common.h"
56
57         test1_26_globalVariable2 = 26000000
58         test1_26_globalVariable3 = 26000000
59         test1_26_globalVariable4 = 26000000
60         test1_26_globalVariable5 = 26000000
61         test1_26_globalVariable6 = 26000000
62         test1_26_globalVariable7 = 26000000
63         test1_26_globalVariable8 = 26000000
64         test1_26_globalVariable9 = 26000000
65         test1_26_globalVariable10 = 26000000
66         test1_26_globalVariable11 = 26000000
67         test1_26_globalVariable12 = 26000000
68         test1_26_globalVariable13 = 26000000
69
70         END
71
72 !------------------------------------------------------------------------------
73
74         SUBROUTINE func26_1
75 #include "test1_26F_common.h"
76
77         print *, 'Skipped test #26 (field operators)'
78         print *, '       - not implemented in Fortran'
79         passedTest = 1
80 ! What does this next line mean?  Is like #if 0?
81 #if notdef
82         INTEGER i
83
84         TYPE (struct26_2) test1_26_globalVariable1
85
86         passedTest = 
87         test1_26_globalVariable1%field1 = 26001001
88         test1_26_globalVariable1%field2 = 26001002
89
90         DO i = 1, 10, 1
91         test1_26_globalVariable1%field3 (i) = 26001002 + i
92         ENDDO
93
94         test1_26_globalVariable1%field4%field1 = 26000013;
95         test1_26_globalVariable1%field4%field2 = 26000014;
96
97         CALL test1_26_call1
98
99         CALL FverifyScalarValue ("test1_26_globalVariable2",
100      & test1_26_globalVariable2, 26001001, 26, "field operators")
101         CALL FverifyScalarValue ("test1_26_globalVariable3",
102      & test1_26_globalVariable3, 26001002, 26, "field operators")
103         CALL FverifyScalarValue ("test1_26_globalVariable4",
104      & test1_26_globalVariable4, 26001003, 26, "field operators")
105         CALL FverifyScalarValue ("test1_26_globalVariable5",
106      & test1_26_globalVariable5, 26001003+5, 26, "field operators")
107         CALL FverifyScalarValue ("test1_26_globalVariable6",
108      & test1_26_globalVariable6, 26000013, 26, "field operators")
109         CALL FverifyScalarValue ("test1_26_globalVariable7",
110      & test1_26_globalVariable7, 26000014, 26, "field operators")
111
112         CALL FverifyScalarValue ("test1_26_globalVariable8",
113      & test1_26_globalVariable8, 26002001, 26, "field operators")
114         CALL FverifyScalarValue ("test1_26_globalVariable9",
115      & test1_26_globalVariable9, 26002002, 26, "field operators")
116         CALL FverifyScalarValue ("test1_26_globalVariable10",
117      & test1_26_globalVariable10, 26002003, 26, "field operators")
118         CALL FverifyScalarValue ("test1_26_globalVariable11",
119      & test1_26_globalVariable11, 26002003+5, 26, "field operators")
120         CALL FverifyScalarValue ("test1_26_globalVariable12",
121      & test1_26_globalVariable12, 26002013, 26, "field operators")
122         CALL FverifyScalarValue ("test1_26_globalVariable13",
123      & test1_26_globalVariable13, 26002014, 26, "field operators")
124
125         if (passedTest .eq. 1) then
126         endif
127 #else
128 #endif
129         END
130
131 !------------------------------------------------------------------------------
132
133         SUBROUTINE test1_26_call1
134 #include "test1_26F_common.h"
135
136         INTEGER i
137
138 #if !defined (F77)
139         TYPE (struct26_2) localVariable26_1
140
141         localVariable26_1%field1 = 26002001
142         localVariable26_1%field2 = 26002002
143
144         DO i = 1, 10, 1
145         localVariable26_1%field3 (i) = 26002002 + i
146         ENDDO
147
148         localVariable26_1%field4%field1 = 26002013
149         localVariable26_1%field4%field2 = 26002014
150
151         CALL test1_26_call2
152 #endif
153         END
154
155 !------------------------------------------------------------------------------
156
157         SUBROUTINE test1_26_call2
158         INTEGER foo = 0
159         END
160
161 !------------------------------------------------------------------------------
162
163         SUBROUTINE FverifyScalarValue (name, a, value, testNum, testName)
164 #include "test1_26F_common.h"
165         CHARACTER *(*) name, testName
166         INTEGER a, value, testNum
167
168         if (a .ne. value) then
169                 if (passedTest .eq. 1) then
170                         print *, '**Failed** test ', testNum, ' (', testName, ')'
171                 endif
172                 print *, '  ', name, ' = ', a, ', not ', value
173                 passedTest = 0
174         endif
175         END
176
177 !------------------------------------------------------------------------------