[RFA] gdbtk_locate_main cleanup

[RFA] gdbtk_locate_main cleanup

[Martin M. Hunt]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 1768 bytes --]

see http://sources.redhat.com/ml/insight/2001-q3/msg00006.html for discussion

2001-07-21  Martin M. Hunt  <hunt@redhat.com>

	* library/interface.tcl (gdbtk_locate_main): Fix function 
	so that it returns either a null string or a valid location,
	as documented.

Index: interface.tcl
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/interface.tcl,v
retrieving revision 1.26
diff -u -p -r1.26 interface.tcl
--- interface.tcl	2001/06/04 15:49:53	1.26
+++ interface.tcl	2001/07/21 07:28:00
@@ -774,24 +774,33 @@ proc gdbtk_tcl_exec_file_display {filena
 #  3: source line number
 #  4: address
 #  5: current PC - which will often be the same as address, but not when
-#  6: shared library name if the pc is in a shared lib
 #  we are browsing, or walking the stack.
+#  6: shared library name if the pc is in a shared lib
 #
 # ------------------------------------------------------------------
 proc gdbtk_locate_main {} {
+  set result {}
   set main_names [pref get gdb/main_names]
   debug "Searching $main_names"
+
   foreach main $main_names {
     if {![catch {gdb_search functions $main -static 1}] \
         && ![catch {gdb_loc $main} linespec]} {
-      return $linespec
+      set result $linespec
+      break
     }
   }
-  if {![catch gdb_entry_point entry_point]
+  if {$result == {} 
+      && ![catch gdb_entry_point entry_point]
       && ![catch {gdb_loc "*$entry_point"} linespec]} {
-    return $linespec
+    set result $linespec
   }
-  return {}
+  
+  # need to see if result is valid
+  lassign $result file func ffile line addr rest
+  if {$addr == 0x0 && $func == {}} { set result {} }
+
+  return $result
 }
 
 ##############################################
ÿHHHÿGGGÿA

Re: [RFA] gdbtk_locate_main cleanup

[Fernando Nasser]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 2193 bytes --]

"Martin M. Hunt" wrote:
> 
> see http://sources.redhat.com/ml/insight/2001-q3/msg00006.html for discussion
> 
> 2001-07-21  Martin M. Hunt  <hunt@redhat.com>
> 
>         * library/interface.tcl (gdbtk_locate_main): Fix function
>         so that it returns either a null string or a valid location,
>         as documented.
> 

Approved.
Thanks!

Fernando

P.S.: Martin, I believe you have a corrupted .signature file (see below)


> Index: interface.tcl
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtk/library/interface.tcl,v
> retrieving revision 1.26
> diff -u -p -r1.26 interface.tcl
> --- interface.tcl       2001/06/04 15:49:53     1.26
> +++ interface.tcl       2001/07/21 07:28:00
> @@ -774,24 +774,33 @@ proc gdbtk_tcl_exec_file_display {filena
>  #  3: source line number
>  #  4: address
>  #  5: current PC - which will often be the same as address, but not when
> -#  6: shared library name if the pc is in a shared lib
>  #  we are browsing, or walking the stack.
> +#  6: shared library name if the pc is in a shared lib
>  #
>  # ------------------------------------------------------------------
>  proc gdbtk_locate_main {} {
> +  set result {}
>    set main_names [pref get gdb/main_names]
>    debug "Searching $main_names"
> +
>    foreach main $main_names {
>      if {![catch {gdb_search functions $main -static 1}] \
>          && ![catch {gdb_loc $main} linespec]} {
> -      return $linespec
> +      set result $linespec
> +      break
>      }
>    }
> -  if {![catch gdb_entry_point entry_point]
> +  if {$result == {}
> +      && ![catch gdb_entry_point entry_point]
>        && ![catch {gdb_loc "*$entry_point"} linespec]} {
> -    return $linespec
> +    set result $linespec
>    }
> -  return {}
> +
> +  # need to see if result is valid
> +  lassign $result file func ffile line addr rest
> +  if {$addr == 0x0 && $func == {}} { set result {} }
> +
> +  return $result
>  }
> 
>  ##############################################

???
> ÿHHHÿGGGÿA

-- 
Fernando Nasser
Red Hat Canada Ltd.                     E-Mail:  fnasser@redhat.com
2323 Yonge Street, Suite #300
Toronto, Ontario   M4P 2C9