summaryrefslogtreecommitdiff
path: root/gdb/testsuite/lib/pascal.exp
blob: 0293d489c3d300c747c75547529c870a57c29d04 (plain)
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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
# Copyright 2007-2021 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
    gdb_persistent_global pascal_compiler_is_gpc
    gdb_persistent_global pascal_compiler_is_fpc
    gdb_persistent_global gpc_compiler
    gdb_persistent_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 destfile type options} {
    global gpc_compiler
    set add_flags ""
    set dest [target_info name]

    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"
	    }
	}
	if { $i == "class" } {
	    if [board_info $dest exists pascal_class_flags] {
		append add_flags " [board_info $dest pascal_class_flags]"
	    } else {
		append add_flags " --extended-syntax"
	    }
	}
    }

    set result [remote_exec host $gpc_compiler "-o $destfile --automake $add_flags $source"]
    return $result
}

proc fpc_compile {source destfile type options} {
    global fpc_compiler
    set add_flags ""
    set dest [target_info name]

    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"
	    }
	}
	if { $i == "class" } {
	    if [board_info $dest exists pascal_class_flags] {
		append add_flags " [board_info $dest pascal_class_flags]"
	    } else {
		append add_flags " -Mobjfpc"
	    }
	}
    }

    set result [remote_exec host $fpc_compiler "-o$destfile $add_flags $source"]
    return $result
}

proc gdb_compile_pascal {source destfile type options} {
    global pascal_init_done
    global pascal_compiler_is_gpc
    global pascal_compiler_is_fpc

    if { $pascal_init_done == 0 } { 
	pascal_init
    }

    file delete $destfile

    if { $pascal_compiler_is_fpc == 1 } {
        set result [fpc_compile $source $destfile $type $options]
    } elseif { $pascal_compiler_is_gpc == 1 } {
        set result [gpc_compile $source $destfile $type $options]
    } else {
	unsupported "no pascal compiler found"
	return "No pascal compiler. Compilation failed."
    }

    if ![file exists $destfile] {
        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
}