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