gdb/testsuite/lib/pascal.exp

   1 # Copyright 2007, 2008, 2009, 2010, 2011 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     global pascal_compiler_is_gpc
  37     global pascal_compiler_is_fpc
  38     global gpc_compiler
  39     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 dest type options} {
  72     global gpc_compiler
  73     set add_flags ""
  74     if {$type == "object"} {
  75         append add_flags " -c"
  76     }
  77
  78     if { $type == "preprocess" } {
  79         append add_flags " -E"
  80     }
  81
  82     if { $type == "assembly" } {
  83         append add_flags " -S"
  84     }
  85
  86     foreach i $options {
  87         if { $i == "debug" } {
  88             if [board_info $dest exists debug_flags] {
  89                 append add_flags " [board_info $dest debug_flags]";
  90             } else {
  91                 append add_flags " -g"
  92             }
  93         }
  94     }
  95
  96     set result [remote_exec host $gpc_compiler "-o $dest --automake $add_flags $source"]
  97     return $result
  98 }
  99
 100 proc fpc_compile {source dest type options} {
 101     global fpc_compiler
 102     set add_flags ""
 103     if {$type == "object"} {
 104         append add_flags " -Cn"
 105     }
 106
 107     if { $type == "preprocess" } {
 108         return "Free Pascal can not preprocess"
 109     }
 110
 111     if { $type == "assembly" } {
 112         append add_flags " -al"
 113     }
 114
 115     foreach i $options {
 116         if { $i == "debug" } {
 117             if [board_info $dest exists debug_flags] {
 118                 append add_flags " [board_info $dest debug_flags]";
 119             } else {
 120                 append add_flags " -g"
 121             }
 122         }
 123     }
 124
 125     set result [remote_exec host $fpc_compiler "-o$dest $add_flags $source"]
 126     return $result
 127 }
 128
 129 proc gdb_compile_pascal {source dest type options} {
 130     global pascal_init_done
 131     global pascal_compiler_is_gpc
 132     global pascal_compiler_is_fpc
 133
 134     if { $pascal_init_done == 0 } {
 135         pascal_init
 136     }
 137
 138     if { $pascal_compiler_is_fpc == 1 } {
 139         set result [fpc_compile $source $dest $type $options]
 140     } elseif { $pascal_compiler_is_gpc == 1 } {
 141         set result [gpc_compile $source $dest $type $options]
 142     } else {
 143         unsupported "No pascal compiler found"
 144         return "No pascal compiler. Compilation failed."
 145     }
 146
 147     if ![file exists $dest] {
 148         unsupported "Pascal compilation failed: $result"
 149         return "Pascal compilation failed."
 150     }
 151 }
 152
 153 # Auxiliary function to set the language to pascal.
 154 # The result is 1 (true) for success, 0 (false) for failure.
 155
 156 proc set_lang_pascal {} {
 157     if [gdb_test_no_output "set language pascal"] {
 158         return 0
 159     }
 160     if [gdb_test "show language" ".* source language is \"pascal\"." \
 161            "set language to \"pascal\""] {
 162         return 0
 163     }
 164     return 1;
 165 }