Experimental Physics and
Industrial Control System

Pam Gurd <[email protected]> · Tue, 26 May 2009 16:05:17 -0700

(copy of a message sent to Andrew last week)

I am testing an API which uses CA.pm for Perl procedures. My

specification says the procedure should abort when it loses

any CA connections.  So I've started a soft IOC, started this test
procedure, and then stop the soft IOC when it tells me to.  It sleeps
for a minute to allow CA to really disconnect (and there is a message)
but it never gets to the callback routine.  (Actually, it gets there

once during channel creation - but not when the channel really

connects.) Am I doing something wrong here?

(This is a simplified version which cuts out anything not essential to

this test. I was hoping I'd get it to work and then be able to fix the

version in my API.)

Thanks.

    Pam.

#!/bin/perl -w
#
# File:        CA_test_subsequent_disconnect.pl
# Author:    Pam Gurd
# Date:        May 19, 2009
#
###############################################
# script to test the connectPVs routine in CPP.pm
###############################################
#
# CVS    $Revision: $
#    $Date: $
#    $Author: $
#
# History:
#    $Log: $
#
#####################
use lib '/usr1/local/epics/release/R3.14.10/base/lib/perl';
use CA;
##################

sub INT_handler (;$);

our $startupflag = 1;
my @message_log = ();
my $no_status=0;
my $channel = CA->new("TEST:DEV1:CUR", &connectionCallback);

$SIG{'INT'} = 'INT_handler';
$SIG{__DIE__} = 'INT_handler';

CA->pend_io(3);
print "testing connection for TEST:DEV1:CUR\n";
die "TEST:DEV1:CUR is not connected.\n"
           unless $channel->is_connected;
print "TEST:DEV1:CUR is connected.\n";

CA->pend_event(1);
$startupflag = 0;

printf("Stop the soft IOC and then press Enter ");
my $filename = <>;

printf("Wait 1 minute for EPICS disconnect\n");
sleep 60;
CA->pend_io(1);
CA->pend_event(1);
printf "3...";
sleep 1;
printf "2...";
sleep 1;
printf "1...";
printf "\nTest failed!\n";

sub INT_handler (;$) {
   my ($message) = @_;
   if ($message) {
       print $message;
       exit 1;
   }
   exit;
}

sub connectionCallback ($$) {
   my ($chan, $connectionStatus) = @_;

   if ($startupflag) {
       return;
   }
   print "connection callback!";
   if ($connectionStatus) {
       print " status=$connectionStatus\n";
   } else {
       print " undef status\n";

       INT_handler(" error: $chan->name!\n");
       abortProcedure ();
   }
}

Experimental Physics and Industrial Control System

Experimental Physics and
Industrial Control System