1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
# Copyright 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
load_lib libgloss.exp
set pascal_init_done 0
# This procedure looks for a suitable pascal compiler
# For now only GNU pascal compiler and Free Pascal compiler
# are searched.
# First, environment variable GPC is checked
# if present, GPC compiler is assumed to be the value of
# that environment variable.
# Second, environment variable FPC is checked
# if present, Free Pascal compiler is assumed to be the value of
# that environment variable.
# Third, gpc executable is searched using `which gpc`
# Lastly, fpc executable is searched using `which fpc`
# Using environment variable allows to force
# which compiler is used in testsuite
proc pascal_init {} {
global pascal_init_done
global pascal_compiler_is_gpc
global pascal_compiler_is_fpc
global gpc_compiler
global fpc_compiler
global env
if { $pascal_init_done == 1 } {
return
}
set pascal_compiler_is_gpc 0
set pascal_compiler_is_fpc 0
set gpc_compiler [transform gpc]
set fpc_compiler [transform fpc]
if ![is_remote host] {
if { [info exists env(GPC)] } {
set pascal_compiler_is_gpc 1
set gpc_compiler $env(GPC)
verbose -log "Assuming GNU Pascal ($gpc_compiler)"
} elseif { [info exists env(FPC)] } {
set pascal_compiler_is_fpc 1
set fpc_compiler $env(FPC)
verbose -log "Assuming Free Pascal ($fpc_compiler)"
} elseif { [which $gpc_compiler] != 0 } {
set pascal_compiler_is_gpc 1
verbose -log "GNU Pascal compiler found"
} elseif { [which $fpc_compiler] != 0 } {
set pascal_compiler_is_fpc 1
verbose -log "Free Pascal compiler found"
}
}
set pascal_init_done 1
}
proc gpc_compile {source dest type options} {
global gpc_compiler
set add_flags ""
if {$type == "object"} {
append add_flags " -c"
}
if { $type == "preprocess" } {
append add_flags " -E"
}
if { $type == "assembly" } {
append add_flags " -S"
}
foreach i $options {
if { $i == "debug" } {
if [board_info $dest exists debug_flags] {
append add_flags " [board_info $dest debug_flags]";
} else {
append add_flags " -g"
}
}
}
set result [remote_exec host $gpc_compiler "-o $dest --automake $add_flags $source"]
return $result
}
proc fpc_compile {source dest type options} {
global fpc_compiler
set add_flags ""
if {$type == "object"} {
append add_flags " -Cn"
}
if { $type == "preprocess" } {
return "Free Pascal can not preprocess"
}
if { $type == "assembly" } {
append add_flags " -al"
}
foreach i $options {
if { $i == "debug" } {
if [board_info $dest exists debug_flags] {
append add_flags " [board_info $dest debug_flags]";
} else {
append add_flags " -g"
}
}
}
set result [remote_exec host $fpc_compiler "-o$dest $add_flags $source"]
return $result
}
proc gdb_compile_pascal {source dest type options} {
global pascal_init_done
global pascal_compiler_is_gpc
global pascal_compiler_is_fpc
if { $pascal_init_done == 0 } {
pascal_init
}
if { $pascal_compiler_is_fpc == 1 } {
set result [fpc_compile $source $dest $type $options]
} elseif { $pascal_compiler_is_gpc == 1 } {
set result [gpc_compile $source $dest $type $options]
} else {
unsupported "No pascal compiler found"
return "No pascal compiler. Compilation failed."
}
if ![file exists $dest] {
unsupported "Pascal compilation failed: $result"
return "Pascal compilation failed."
}
}
# Auxiliary function to set the language to pascal.
# The result is 1 (true) for success, 0 (false) for failure.
proc set_lang_pascal {} {
if [gdb_test_no_output "set language pascal"] {
return 0
}
if [gdb_test "show language" ".* source language is \"pascal\"." \
"set language to \"pascal\""] {
return 0
}
return 1;
}
|
