# TSTcore.def: Tests Stack Trace Extraction
# $Id: TSTcore.def,v 1.9 2008/02/25 17:32:56 mschenke Exp $
# ARCS: $Header: /home/cvs/repository/RDA_4/src/scripting/lib/modules/TSTcore.def,v 1.9 2008/02/25 17:32:56 mschenke Exp $
#
# Change History
# 20080225  MSC  Change the copyright notice.

=head1 NAME

TSTcore - Tests Stack Trace Extraction

=head1 DESCRIPTION

This test module extracts the stack trace from a system core dump.

=cut

# Get the core file
if getSetting('TST_ARGS')
 var $dmp = last
elsif getEnv('CORE')
 var $dmp = last
elsif getSetting('CORE')
 var $dmp = last
else
{call requestSetting('TSTcore')
 var $dmp = getSetting('CORE')
}

if !testFile('fr',$dmp)
 die 'Missing or invalid file'

# Try to extract the program name that produced the core
var $pgm = field("'",1,command(concat('file ',quote($dmp,'x'))))

# Find a debugger
if match(getOsName(),'sunos')
 var @loc = ('pstack')
else
 var @loc = ()
var $flg = true
var %opt = ('gdb',' -quiet')
loop $typ (@loc,'gdb','adb','dbx','sdb')
{if findCommand($typ,true)
 {var $dbg = last
  if testFile('x',$dbg)
  {var $flg = false
   break
  }
 }
}
if $flg
 die 'No debugger found'

# List the environment, what we know so far
var $sep = repeat('-',getSetting('RDA_COLUMNS'))
echo $sep
echo 'Stack Trace Extraction Utility - Version 0.1'
echo 'Copyright (c) 2005-2008, Oracle. All rights reserved.'
echo 'Core file: ',$dmp
echo 'Program  : ',$pgm
echo 'Debugger : ',$dbg
echo $sep

# Extract information from the core file
macro dsp_command
{import $sep

 if loadCommand($arg[0])
 {loop $lin (getLines())
   echo $lin
 }
 echo $sep
}

if match($dbg,'pstack$')
{# If pstack is available, just call the code and be done with it.
 call dsp_command(concat(quote($dbg,'x'),' ',quote($dmp,'x')))

 # If we found pmap, run it
 if findCommand('pmap')
  call dsp_command(concat(last,' ',quote($dmp,'x')))

 # If we found pflags, run it too
 if findCommand('pflags')
  call dsp_command(concat(last,' ',quote($dmp,'x')))
}
else
{# Extract possible executables from the corefile
 var ($flg,%exe) = ()
 loop $fil ($pgm,\
            catFile(dirname($dmp),$pgm),\
            grepCommand(concat('strings ',quote($dmp,'x')),\
            concat('^(.*\/)?',$pgm,'$')))
 {var $fil = replace($fil,'^\.\/')
  if testFile('x',$fil)
  {next testDir('d',$fil)
   var $exe{$fil} = 1
   var $flg = true
  }
 }

 # Try to extract the stack trace
 if $flg
 {# Initialize the debugger input file
  var $inp = createTemp('debug')
  if match($dbg,'gdb$')
  {call writeTemp('debug','thread apply all where')
   call writeTemp('debug','q')
  }
  elsif match($dbg,'adb$')
  {call writeTemp('debug','$c')
   call writeTemp('debug','$q')
  }
  elsif match($dbg,'sdb$')
  {call writeTemp('debug','t')
   call writeTemp('debug','quit')
  }
  elsif match($dbg,'dbx$')
  {call writeTemp('debug','where')
   call writeTemp('debug','quit')
  }
  call closeTemp('debug')

  # Try them individually to extract a stack trace.
  loop $exe (keys(%exe))
  {echo 'Core extraction attempted with ',$exe,':'
   call dsp_command(concat(quote($dbg,'x'),$opt{$typ},' ',quote($exe,'x'),' ',\
                           quote($dmp,'x'),' <',quote($inp,'x')))
  }

  # Remove the temporary debug file
  call unlinkTemp('debug')
 }
 else
  echo 'Program not found'
}
echo "Stack trace extraction done."

=head1 COPYRIGHT NOTICE

Copyright (c) 2002-2008, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of Oracle
Corporation and/or its affiliates. Other names may be trademarks of their
respective owners.

=cut