gdb/testsuite/lib/pascal.exp

   1 # Copyright 2007-2022 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
  16 load_lib libgloss.exp
  17
  18 set 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
  34 proc 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
  71 proc 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
 109 proc 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
 147 proc 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
 176 proc 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 }