Clear version snapshot for 3.16.1 final release

Also ensures clientQ is initialized before creating clientQlock.

Fixes LP: #1694966

.gitignore

@@ -6,7 +6,9 @@
 /html/
 /include/
 /templates/
+/configure/*.local
 O.*/
 /QtC-*
 *.orig
 *.log
+.*.swp

ci/appveyor-make.bat

@@ -112,5 +112,7 @@ cl
 echo [INFO] EPICS_HOST_ARCH: %EPICS_HOST_ARCH%
 echo [INFO] Make version
 %MAKE% --version
+echo [INFO] Perl version
+perl --version
 
 %MAKE% %MAKEARGS% %*

configure/CONFIG_BASE

@@ -66,6 +66,7 @@ DBTOMENUH                  = $(PERL) $(TOOLS)/dbdToMenuH.pl
 REGISTERRECORDDEVICEDRIVER = $(PERL) $(TOOLS)/registerRecordDeviceDriver.pl
 CONVERTRELEASE             = $(PERL) $(call FIND_TOOL,convertRelease.pl)
 FULLPATHNAME               = $(PERL) $(TOOLS)/fullPathName.pl
+TAPTOJUNIT                 = $(PERL) $(TOOLS)/tap-to-junit-xml.pl
 GENVERSIONHEADER           = $(PERL) $(TOOLS)/genVersionHeader.pl $(QUIET_FLAG)
 
 #---------------------------------------------------------------

configure/CONFIG_BASE_VERSION

@@ -50,11 +50,11 @@ EPICS_PATCH_LEVEL = 0
 #EPICS_DEV_SNAPSHOT=-pre1-DEV
 #EPICS_DEV_SNAPSHOT=-pre2
 #EPICS_DEV_SNAPSHOT=-pre2-DEV
-EPICS_DEV_SNAPSHOT=-rc1
+#EPICS_DEV_SNAPSHOT=-rc1
 #EPICS_DEV_SNAPSHOT=-rc1-DEV
 #EPICS_DEV_SNAPSHOT=-rc2
 #EPICS_DEV_SNAPSHOT=-rc2-DEV
-#EPICS_DEV_SNAPSHOT=
+EPICS_DEV_SNAPSHOT=
 
 # No changes should be needed below here
 

configure/CONFIG_SITE

@@ -117,11 +117,10 @@ CROSS_COMPILER_TARGET_ARCHS=
 #  configure/os/CONFIG_SITE.<host>.Common files instead.
 CROSS_COMPILER_HOST_ARCHS=
 
-#  The 'make runtests' and 'make tapfiles' build targets normally only run
+#  The 'runtests', 'tapfiles' and 'junitfiles' make targets normally only run
 #  self-tests for the EPICS_HOST_ARCH architecture. If the host can execute
 #  the self-test programs for any other cross-built architectures such as
-#  a -debug architecture, those architectures can be named here.
-#
+#  a -debug architecture, those architectures must be named in this variable:
 CROSS_COMPILER_RUNTEST_ARCHS=
 
 # Build shared libraries (DLLs on Windows).
@@ -175,3 +174,5 @@ GCC_PIPE = NO
 #  run at build-time, e.g. set the LD_LIBRARY_PATH environment variable.
 LINKER_USE_RPATH = YES
 
+# Overrides for the settings above may appear in a CONFIG_SITE.local file
+-include $(CONFIG)/CONFIG_SITE.local

configure/RELEASE

@@ -1,19 +1,20 @@
 #*************************************************************************
-# Copyright (c) 2002 The University of Chicago, as Operator of Argonne
+# Copyright (c) 2012 UChicago Argonne LLC, as Operator of Argonne
 #     National Laboratory.
 # Copyright (c) 2002 The Regents of the University of California, as
 #     Operator of Los Alamos National Laboratory.
-# EPICS BASE Versions 3.13.7
-# and higher are distributed subject to a Software License Agreement found
-# in file LICENSE that is included with this distribution. 
+# EPICS BASE is distributed subject to a Software License Agreement found
+# in the file LICENSE that is included with this distribution.
 #*************************************************************************
-# RELEASE: Define location of external EPICS products
 
+#
+# RELEASE: Define the location of external EPICS products
+#
+
+# The version of this file in Base should normally be empty.
+#
 # Define INSTALL_LOCATION in CONFIG_SITE
 
-# VX_DIR definition now in os/CONFIG_SITE.Common.vxWorksCommon
-# RTEMS_BASE (and RTEMS_VERSION) now in os/CONFIG_SITE.Common.RTEMS
-
 # NB: Settings in RELEASE files can be overridden in files named
 #   RELEASE.$(EPICS_HOST_ARCH).Common
 #   RELEASE.Common.$(T_A)

configure/RULES.Db

@@ -154,7 +154,7 @@ ACTIONS = inc
 ACTIONS += build
 ACTIONS += install
 ACTIONS += buildInstall
-ACTIONS += runtests tapfiles
+ACTIONS += runtests tapfiles clean-tests test-results junitfiles
 
 actionArchTargets = $(foreach action, $(ACTIONS), \
     $(foreach arch, $(BUILD_ARCHS), $(action)$(DIVIDER)$(arch)))

configure/RULES_ARCHS

@@ -14,7 +14,7 @@ ACTIONS = inc
 ACTIONS += build
 ACTIONS += install
 ACTIONS += buildInstall
-ACTIONS += runtests tapfiles
+ACTIONS += runtests tapfiles clean-tests test-results junitfiles
 
 actionArchTargets = $(foreach action, $(ACTIONS), \
     $(addprefix $(action)$(DIVIDER), $(BUILD_ARCHS)))

configure/RULES_BUILD

@@ -115,6 +115,7 @@ endif
 ifneq (,$(findstring $(T_A),$(EPICS_HOST_ARCH) $(CROSS_COMPILER_RUNTEST_ARCHS)))
 RUNTESTS_ENABLED = YES
 TAPFILES += $(TESTSCRIPTS:.t=.tap)
+JUNITFILES += $(TAPFILES:.tap=.xml)
 endif
 
 #---------------------------------------------------------------
@@ -165,7 +166,7 @@ build_clean:
 	$(INC) $(TARGETS) $(TDS) $(CLEANS) \
 	*.out MakefileInclude *.manifest *.exp \
 	$(COMMON_INC) $(HDEPENDS_FILES) $(PRODTARGETS) \
-	$(TESTSCRIPTS) $(TAPFILES)
+	$(TESTSCRIPTS) $(TAPFILES) $(JUNITFILES)
 ifdef RES
 	@$(RM) *$(RES)
 endif
@@ -344,7 +345,23 @@ testspec: $(TESTSCRIPTS)
 	$(if $(TESTFILES), @echo Files: $(TESTFILES) >> $@)
 	$(if $(TESTSPEC_$(OS_CLASS)), @echo "Harness: $(TESTSPEC_$(OS_CLASS))" >> $@)
 
+test-results: tapfiles
+ifneq ($(TAPFILES),)
+ifdef RUNTESTS_ENABLED
+	prove --failures --ext .tap --exec cat --color $(TAPFILES)
+endif
+endif
+
+clean-tests:
+ifneq ($(TAPFILES),)
+	$(RM) $(TAPFILES)
+endif
+ifneq ($(JUNITFILES),)
+	$(RM) $(JUNITFILES)
+endif
+
 tapfiles: $(TESTSCRIPTS) $(TAPFILES)
+junitfiles: $(JUNITFILES)
 
 # A .tap file is the output from running the associated test script
 %.tap: %.t
@@ -352,6 +369,9 @@ ifdef RUNTESTS_ENABLED
 	-$(PERL) $< -tap > $@
 endif
 
+%.xml: %.tap
+	$(TAPTOJUNIT) --puretap --output $@ --input $< $*
+
 # If there's a perl test script (.plt) available, use it
 %.t: ../%.plt
 	@$(RM) $@
@@ -504,7 +524,8 @@ $(INSTALL_TEMPLATES_SUBDIR)/%: %
 .PRECIOUS: $(COMMON_INC)
 
 .PHONY: all host inc build install clean rebuild buildInstall build_clean
-.PHONY: runtests tapfiles checkRelease warnRelease noCheckRelease FORCE
+.PHONY: runtests tapfiles clean-tests test-results junitfiles
+.PHONY: checkRelease warnRelease noCheckRelease FORCE
 
 endif # BASE_RULES_BUILD
 #	EOF RULES_BUILD

configure/RULES_DIRS

@@ -9,7 +9,7 @@
 
 ARCHS += $(BUILD_ARCHS)
 ACTIONS += inc build install buildInstall clean realclean archclean
-ACTIONS += runtests tapfiles
+ACTIONS += runtests tapfiles clean-tests test-results junitfiles
 
 dirActionArchTargets = $(foreach dir, $(DIRS), \
     $(foreach action, $(ACTIONS), \

configure/RULES_TOP

@@ -57,6 +57,7 @@ help:
 	@echo "                      Cannot be used within an O.<arch> dir"
 	@echo "     rebuild        - Same as clean install"
 	@echo "     archclean      - Removes O.<arch> dirs but not O.Common dir"
+	@echo "     runtests       - Run self-tests, summarize results"
 	@echo "\"Partial\" build targets supported by Makefiles:"
 	@echo "     host           - Builds and installs $(EPICS_HOST_ARCH) only."
 	@echo "     inc$(DIVIDER)<arch>     - Installs <arch> only header files."

documentation/KnownProblems.html

@@ -4,7 +4,7 @@
 <html xmlns="http://www.w3.org/1999/xhtml">
 <head>
   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
-  <title>Known Problems in R3.16.1</title>
+  <title>Known Problems in Base-3.16.1</title>
 </head>
 
 <body>
@@ -15,7 +15,7 @@ base-3.16.1 tree. Download them, then use the GNU Patch program as
 follows:</p>
 
 <blockquote><pre>% <b>cd <i>/path/to/</i>base-3.16.1</b>
-% <b>patch -p0 &lt; <i>/path/to/</i>file.patch</b></pre></blockquote>
+% <b>patch -p1 &lt; <i>/path/to/</i>file.patch</b></pre></blockquote>
 
 <p>The following problems were known by the developers at the time of this
 release:</p>
@@ -23,7 +23,8 @@ release:</p>
 <ul>
 
 <!-- Items added after release should be formatted thusly:
-  <li>YYYY-MM-DD: Description of problem
+  <li>YYYY-MM-DD: Description of problem.
+    <a href="fix.patch">This patch</a> fixes the problem.
     ...</li>
 -->
 

documentation/README.1st

@@ -6,19 +6,19 @@
 
   Table of Contents
 
-     *<EFBFBD>What is EPICS base?
-     *<EFBFBD>What is new in this release?
-     *<EFBFBD>Copyright
-     *<EFBFBD>Supported platforms
-     *<EFBFBD>Supported compilers
-     *<EFBFBD>Software requirements
-     *<EFBFBD>Host system storage requirements
-     *<EFBFBD>Documentation
-     *<EFBFBD>Directory Structure
-     *<EFBFBD>Build related components
-     *<EFBFBD>Building EPICS base (Unix and Win32)
-     *<EFBFBD>Example application and extension
-     *<EFBFBD>Multiple host platforms
+     * What is EPICS base?
+     * What is new in this release?
+     * Copyright
+     * Supported platforms
+     * Supported compilers
+     * Software requirements
+     * Host system storage requirements
+     * Documentation
+     * Directory Structure
+     * Build related components
+     * Building EPICS base (Unix and Win32)
+     * Example application and extension
+     * Multiple host platforms
 
    --------------------------------------------------------------------------
 

documentation/RELEASE_NOTES.html

@@ -9,10 +9,6 @@
 <body lang="en">
 <h1 align="center">EPICS Base Release 3.16.1</h1>
 
-<p style="color:red">This version of EPICS Base has not been released yet.</p>
-
-
-<h2 align="center">Changes made on the 3.16 branch since 3.16.0.1</h2>
 <!-- Insert new items immediately below this template ...
 
 <h3>Title...</h3>
@@ -21,6 +17,8 @@
 
 -->
 
+<h2 align="center">Changes made between 3.16.0.1 and 3.16.1</h2>
+
 <h3>IOC Database Support for 64-bit integers</h3>
 
 <p>The IOC now supports the 64-bit integer field types <tt>DBF_INT64</tt> and
@@ -586,10 +584,52 @@ of its CALLBACK objects.</p>
 
 <!-- Insert inherited items immediately below here ... -->
 
+<h3>Support for CONFIG_SITE.local in Base</h3>
+
+<p>This feature is mostly meant for use by developers; configuration
+settings that would normally appear in Base/configure/CONFIG_SITE can now
+be put in a locally created base/configure/CONFIG_SITE.local file instead
+of having go modify or replace the original. A new .gitignore pattern
+tells git to ignore all configure/*.local files.</p>
+
+
 <h2 align="center">Changes from the 3.14 branch since 3.15.5</h2>
 
 <!-- Insert inherited items immediately below here ... -->
 
+<h3>New test-related make targets</h3>
+
+<p>This release adds several new make targets intended for use by developers
+and Continuous Integration systems which simplify the task of running the
+built-in self-test programs and viewing the results. Since these targets are
+intended for limited use they can have requirements for the build host which
+go beyond the standard minimum set needed to build and run Base.</p>
+
+<blockquote>
+
+<h4><tt>test-results</tt> &mdash; Summarize test results</h4>
+
+<p>The new make target <tt>test-results</tt> will run the self-tests if
+necessary to generate a TAP file for each test, then summarizes the TAP output
+files in each test directory in turn, displaying the details of any failures.
+This step uses the program <q>prove</q> which comes with Perl, but also needs
+<q>cat</q> to be provided in the default search path so will not work on most
+Windows systems.</p>
+
+<h4><tt>junitfiles</tt> &mdash; Convert test results to JUnit XML Format</h4>
+
+<p>The new make target <tt>junitfiles</tt> will run the self-tests if necessary
+and then convert the TAP output files into the more commonly-supported JUnit
+XML format. The program that performs this conversion needs the Perl module
+<q><tt>XML::Generator</tt></q> to have been installed.</p>
+
+<h4><tt>clean-tests</tt> &mdash; Delete test result files</h4>
+
+<p>The new make target <tt>clean-tests</tt> removes any test result files from
+previous test runs. It cleans both TAP and JUnit XML files.</p>
+
+</blockquote>
+
 <h3>Fix DNS related crash on exit</h3>
 
 <p>The attempt to fix DNS related delays for short lived CLI programs (eg. caget)

documentation/ReleaseChecklist.html

@@ -157,8 +157,8 @@ the final release version.</p>
         <blockquote><tt>
           cd base-3.16<br />
           git archive
-            --prefix=base-3.16.1-rc1
-            --output=base-3.16.1-rc1.tar.gz
+            --prefix=base-3.16.1-rc1/
+            --output=../base-3.16.1-rc1.tar.gz
             R3.16.1-rc1
             configure documentation LICENSE Makefile README src startup
           </tt></blockquote>
@@ -289,8 +289,8 @@ the final release version.</p>
         <blockquote><tt>
           cd base-3.16<br />
           git archive
-            --prefix=base-3.16.1
-            --output=base-3.16.1.tar.gz
+            --prefix=base-3.16.1/
+            --output=../base-3.16.1.tar.gz
             R3.16.1
             configure documentation LICENSE Makefile README src startup
           </tt></blockquote>

src/ca/client/CAref.html

@@ -316,7 +316,7 @@ is used.</p>
     </tr>
     <tr>
       <td>EPICS_CA_AUTO_ARRAY_BYTES</td>
-      <td>i &gt;= YES</td>
+      <td>{YES, NO}</td>
       <td>YES</td>
     </tr>
     <tr>
@@ -756,6 +756,12 @@ in the variable EPICS_TS_MIN_WEST.</p>
 
 <h3><a name="Configurin1">Configuring the Maximum Array Size</a></h3>
 
+<p>From version R3.16.1, the default setting of EPICS_CA_AUTO_ARRAY_BYTES=YES
+will cause the software to ignore EPICS_CA_MAX_ARRAY_BYTES and attempt to
+allocate network buffer space as needed by the particular client connection
+using malloc. Setting EPICS_CA_AUTO_ARRAY_BYTES=NO will configure the software
+to respect the EPICS_CA_MAX_ARRAY_BYTES setting as described below instead.</p>
+
 <p>Starting with version R3.14 the environment variable
 EPICS_CA_MAX_ARRAY_BYTES determines the size of the largest array that may pass
 through CA. Prior to this version only arrays smaller than 16k bytes could be
@@ -764,11 +770,6 @@ buffers that are used for ordinary communication. If EPICS_CA_MAX_ARRAY_BYTES
 is larger than 16384 then a second free list of larger data buffers is
 established and used only after a client send its first large array request.</p>
 
-<p>Beginning with R3.16.1, EPICS_CA_AUTO_ARRAY_BYTES=YES (the default) will ignore
-EPICS_CA_MAX_ARRAY_BYTES and attempt to allocate sufficient buffer space
-as needed.  Setting EPICS_CA_AUTO_ARRAY_BYTES=NO will continue to respect
-EPICS_CA_MAX_ARRAY_BYTES.</p>
-
 <p>The CA client library uses EPICS_CA_MAX_ARRAY_BYTES to determines the
 maximum array that it will send or receive. Likewise, the CA server uses
 EPICS_CA_MAX_ARRAY_BYTES to determine the maximum array that it may send or
@@ -783,11 +784,7 @@ array larger than EPICS_CA_MAX_ARRAY_BYTES it will return ECA_TOLARGE.</p>
 by multiplying the number of elements by the size of a single element, but
 neglect to add additional bytes for the compound data types (for example
 DBR_GR_DOUBLE) commonly used by the more sophisticated client side
-applications. <em>Based on this confusion, one could arrive at the conclusion
-that EPICS_CA_MAX_ARRAY_BYTES might have been better named
-EPICS_CA_MAX_DATUM_BYTES, or that the software should be changed internally to
-round the users request up by the size of the maximum scalar datum (nothing has
-been done to address this issue so far).</em></p>
+applications.</p>
 
 <h3><a name="Configurin2">Configuring a CA Server</a></h3>
 

src/ca/legacy/pcas/generic/casStrmClient.cc

@@ -540,8 +540,20 @@ caStatus casStrmClient::readResponse ( epicsGuard < casClientMutex > & guard,
             pChan->getCID(), status, ECA_GETFAIL );
     }
 
+    aitUint32 elementCount = 0;
+    if (desc.isContainer()) {
+        aitUint32 index;
+        int gdds = gddApplicationTypeTable::app_table.mapAppToIndex
+            ( desc.applicationType(), gddAppType_value, index );
+        if ( gdds ) {
+            return S_cas_badType;
+        }
+        elementCount = desc.getDD(index)->getDataSizeElements();
+    } else {
+        elementCount = desc.getDataSizeElements();
+    }
     ca_uint32_t count = (msg.m_count == 0) ?
-                            (ca_uint32_t)desc.getDataSizeElements() :
+                            (ca_uint32_t)elementCount :
                              msg.m_count;
 
     void * pPayload;
@@ -669,8 +681,20 @@ caStatus casStrmClient::readNotifyResponse ( epicsGuard < casClientMutex > & gua
         return ecaStatus;
     }
 
+    aitUint32 elementCount = 0;
+    if (desc.isContainer()) {
+        aitUint32 index;
+        int gdds = gddApplicationTypeTable::app_table.mapAppToIndex
+            ( desc.applicationType(), gddAppType_value, index );
+        if ( gdds ) {
+            return S_cas_badType;
+        }
+        elementCount = desc.getDD(index)->getDataSizeElements();
+    } else {
+        elementCount = desc.getDataSizeElements();
+    }
     ca_uint32_t count = (msg.m_count == 0) ?
-                            (ca_uint32_t)desc.getDataSizeElements() :
+                            (ca_uint32_t)elementCount :
                              msg.m_count;
 
     void *pPayload;

src/ioc/db/dbLink.c

@@ -73,6 +73,12 @@ void dbInitLink(struct link *plink, short dbfType)
 {
     struct dbCommon *precord = plink->precord;
 
+    /* Only initialize link once */
+    if (plink->flags & DBLINK_FLAG_INITIALIZED)
+        return;
+    else
+        plink->flags |= DBLINK_FLAG_INITIALIZED;
+
     if (plink->type == CONSTANT) {
         dbConstInitLink(plink);
         return;

src/ioc/db/dbLock.c

@@ -565,12 +565,10 @@ void dbLockCleanupRecords(dbBase *pdbbase)
 
     forEachRecord(NULL, pdbbase, &freeLockRecord);
     if(ellCount(&lockSetsActive)) {
-        errlogMessage("Warning: dbLockCleanupRecords() leaking lockSets\n");
+        printf("Warning: dbLockCleanupRecords() leaking lockSets\n");
         dblsr(NULL,2);
     }
 
-    assert(ellCount(&lockSetsActive)==0);
-
 #ifndef LOCKSET_NOFREE
     while((cur=ellGet(&lockSetsFree))!=NULL) {
         lockSet *ls = (lockSet*)cur;

src/ioc/dbStatic/link.h

@@ -69,6 +69,8 @@ epicsShareExtern maplinkType pamaplinkType[];
 #define pvlOptOutString  0x400	/*Output as string*/
 #define pvlOptTSELisTime 0x800	/*Field TSEL is getting timeStamp*/
 
+/* DBLINK Flag bits */
+#define DBLINK_FLAG_INITIALIZED    1 /* dbInitLink() called */
 
 struct macro_link {
     char *macroStr;

src/ioc/rsrv/caservertask.c

@@ -489,7 +489,6 @@ int rsrv_init (void)
 
     clientQlock = epicsMutexMustCreate();
 
-    ellInit ( &clientQ );
     freeListInitPvt ( &rsrvClientFreeList, sizeof(struct client), 8 );
     freeListInitPvt ( &rsrvChanFreeList, sizeof(struct channel_in_use), 512 );
     freeListInitPvt ( &rsrvEventFreeList, sizeof(struct event_ext), 512 );

src/ioc/rsrv/server.h

@@ -167,7 +167,7 @@ enum ctl {ctlInit, ctlRun, ctlPause, ctlExit};
 /*  NOTE: external used so they remember the state across loads */
 #ifdef  GLBLSOURCE
 #   define GLBLTYPE
-#   define GLBLTYPE_INIT(A)
+#   define GLBLTYPE_INIT(A) = A
 #else
 #   define GLBLTYPE extern
 #   define GLBLTYPE_INIT(A)
@@ -185,8 +185,7 @@ enum ctl {ctlInit, ctlRun, ctlPause, ctlExit};
 
 GLBLTYPE int                CASDEBUG;
 GLBLTYPE unsigned short     ca_server_port, ca_udp_port, ca_beacon_port;
-GLBLTYPE ELLLIST            clientQ; /* (TCP clients) locked by clientQlock */
-GLBLTYPE ELLLIST            clientQudp; /* locked by clientQlock */
+GLBLTYPE ELLLIST            clientQ             GLBLTYPE_INIT(ELLLIST_INIT);
 GLBLTYPE ELLLIST            servers; /* rsrv_iface_config::node, read-only after rsrv_init() */
 GLBLTYPE ELLLIST            beaconAddrList;
 GLBLTYPE SOCKET             beaconSocket;

src/std/dev/devAaiSoft.c

@@ -4,7 +4,7 @@
 * Copyright (c) 2002 The Regents of the University of California, as
 *     Operator of Los Alamos National Laboratory.
 * EPICS BASE is distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
+* in file LICENSE that is included with this distribution.
 \*************************************************************************/
 
 /*
@@ -53,7 +53,12 @@ epicsExportAddress(dset,devAaiSoft);
 
 static long init_record(aaiRecord *prec)
 {
-    if (prec->inp.type == CONSTANT) {
+    DBLINK *plink = &prec->inp;
+
+    /* This is pass 0, link hasn't been initialized yet */
+    dbInitLink(plink, DBF_INLINK);
+
+    if (dbLinkIsConstant(plink)) {
         long nRequest = prec->nelm;
         long status;
 
@@ -63,10 +68,7 @@ static long init_record(aaiRecord *prec)
                 "devAaiSoft: buffer calloc failed");
         }
 
-        /* This is pass 0 so link hasn't been initialized either */
-        dbConstInitLink(&prec->inp);
-
-        status = dbLoadLinkArray(&prec->inp, prec->ftvl, prec->bptr, &nRequest);
+        status = dbLoadLinkArray(plink, prec->ftvl, prec->bptr, &nRequest);
         if (!status && nRequest > 0) {
             prec->nord = nRequest;
             prec->udf = FALSE;

src/std/dev/devAiSoftCallback.c

@@ -4,7 +4,7 @@
 * Copyright (c) 2002 The Regents of the University of California, as
 *     Operator of Los Alamos National Laboratory.
 * EPICS BASE is distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
+* in file LICENSE that is included with this distribution.
 \*************************************************************************/
 /* devAiSoftCallback.c */
 /*
@@ -80,10 +80,11 @@ static long add_record(dbCommon *pcommon)
     devPvt *pdevPvt;
     processNotify *ppn;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
 
     if (plink->type != PV_LINK) {
-	long status = S_db_badField;
+        long status = S_db_badField;
 
         recGblRecordError(status, (void *)prec,
             "devAiSoftCallback (add_record) Illegal INP field");
@@ -92,7 +93,7 @@ static long add_record(dbCommon *pcommon)
 
     chan = dbChannelCreate(plink->value.pv_link.pvname);
     if (!chan) {
-	long status = S_db_notFound;
+        long status = S_db_notFound;
 
         recGblRecordError(status, (void *)prec,
             "devAiSoftCallback (add_record) link target not found");
@@ -129,7 +130,9 @@ static long del_record(dbCommon *pcommon) {
     DBLINK *plink = &prec->inp;
     devPvt *pdevPvt = (devPvt *)prec->dpvt;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
+
     assert(plink->type == PN_LINK);
 
     dbNotifyCancel(&pdevPvt->pn);
@@ -152,21 +155,9 @@ static long init(int pass)
 
 static long init_record(aiRecord *prec)
 {
-    /* INP must be CONSTANT or PN_LINK */
-    switch (prec->inp.type) {
-    case CONSTANT:
-        if (recGblInitConstantLink(&prec->inp, DBF_DOUBLE, &prec->val))
-            prec->udf = FALSE;
-        break;
-    case PN_LINK:
-        /* Handled by add_record */
-        break;
-    default:
-        recGblRecordError(S_db_badField, (void *)prec,
-            "devAiSoftCallback (init_record) Illegal INP field");
-        prec->pact = TRUE;
-        return S_db_badField;
-    }
+    if (recGblInitConstantLink(&prec->inp, DBF_DOUBLE, &prec->val))
+        prec->udf = FALSE;
+
     return 0;
 }
 
@@ -195,6 +186,7 @@ static long read_ai(aiRecord *prec)
             pdevPvt->buffer.value * (1.0 - prec->smoo);
     else
         prec->val = pdevPvt->buffer.value;
+
     prec->udf = FALSE;
     pdevPvt->smooth = TRUE;
 
@@ -214,9 +206,10 @@ static long read_ai(aiRecord *prec)
             break;
     }
 
-    if (prec->tsel.type == CONSTANT &&
+    if (dbLinkIsConstant(&prec->tsel) &&
         prec->tse == epicsTimeEventDeviceTime)
         prec->time = pdevPvt->buffer.time;
+
     return 2;
 }
 

src/std/dev/devBiSoftCallback.c

@@ -4,7 +4,7 @@
 * Copyright (c) 2002 The Regents of the University of California, as
 *     Operator of Los Alamos National Laboratory.
 * EPICS BASE is distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
+* in file LICENSE that is included with this distribution.
 \*************************************************************************/
 /* devBiSoftCallback.c */
 /*
@@ -78,10 +78,11 @@ static long add_record(dbCommon *pcommon)
     devPvt *pdevPvt;
     processNotify *ppn;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
 
     if (plink->type != PV_LINK) {
-	long status = S_db_badField;
+        long status = S_db_badField;
 
         recGblRecordError(status, (void *)prec,
             "devBiSoftCallback (add_record) Illegal INP field");
@@ -90,7 +91,7 @@ static long add_record(dbCommon *pcommon)
 
     chan = dbChannelCreate(plink->value.pv_link.pvname);
     if (!chan) {
-	long status = S_db_notFound;
+        long status = S_db_notFound;
 
         recGblRecordError(status, (void *)prec,
             "devBiSoftCallback (add_record) link target not found");
@@ -127,7 +128,9 @@ static long del_record(dbCommon *pcommon) {
     DBLINK *plink = &prec->inp;
     devPvt *pdevPvt = (devPvt *)prec->dpvt;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
+
     assert(plink->type == PN_LINK);
 
     dbNotifyCancel(&pdevPvt->pn);
@@ -150,21 +153,9 @@ static long init(int pass)
 
 static long init_record(biRecord *prec)
 {
-    /* INP must be CONSTANT or PN_LINK */
-    switch (prec->inp.type) {
-    case CONSTANT:
-        if (recGblInitConstantLink(&prec->inp, DBR_ENUM, &prec->val))
-            prec->udf = FALSE;
-        break;
-    case PN_LINK:
-        /* Handled by add_record */
-        break;
-    default:
-        recGblRecordError(S_db_badField, (void *)prec,
-            "devBiSoftCallback (init_record) Illegal INP field");
-        prec->pact = TRUE;
-        return S_db_badField;
-    }
+    if (recGblInitConstantLink(&prec->inp, DBR_ENUM, &prec->val))
+        prec->udf = FALSE;
+
     return 0;
 }
 
@@ -205,9 +196,10 @@ static long read_bi(biRecord *prec)
             break;
     }
 
-    if (prec->tsel.type == CONSTANT &&
+    if (dbLinkIsConstant(&prec->tsel) &&
         prec->tse == epicsTimeEventDeviceTime)
         prec->time = pdevPvt->buffer.time;
+
     return 2;
 }
 

src/std/dev/devI64inSoft.c

@@ -47,32 +47,32 @@ epicsExportAddress(dset, devI64inSoft);
 
 static long init_record(int64inRecord *prec)
 {
-    /* INP must be CONSTANT, PV_LINK, DB_LINK or CA_LINK*/
-    switch (prec->inp.type) {
-    case CONSTANT:
-        if (recGblInitConstantLink(&prec->inp, DBF_INT64, &prec->val))
-            prec->udf = FALSE;
-        break;
-    case PV_LINK:
-    case DB_LINK:
-    case CA_LINK:
-        break;
-    default:
-        recGblRecordError(S_db_badField, (void *)prec,
-            "devI64inSoft (init_record) Illegal INP field");
-        return S_db_badField;
-    }
+    if (recGblInitConstantLink(&prec->inp, DBF_INT64, &prec->val))
+        prec->udf = FALSE;
+
     return 0;
 }
 
+static long readLocked(struct link *pinp, void *dummy)
+{
+    int64inRecord *prec = (int64inRecord *) pinp->precord;
+    long status = dbGetLink(&prec->inp, DBR_INT64, &prec->val, 0, 0);
+
+    if (status) return status;
+
+    if (dbLinkIsConstant(&prec->tsel) &&
+        prec->tse == epicsTimeEventDeviceTime)
+        dbGetTimeStamp(pinp, &prec->time);
+
+    return status;
+}
+
 static long read_int64in(int64inRecord *prec)
 {
-    long status;
+    long status = dbLinkDoLocked(&prec->inp, readLocked, NULL);
+
+    if (status == S_db_noLSET)
+        status = readLocked(&prec->inp, NULL);
 
-    status = dbGetLink(&prec->inp, DBR_INT64, &prec->val, 0, 0);
-    if (!status &&
-        prec->tsel.type == CONSTANT &&
-        prec->tse == epicsTimeEventDeviceTime)
-        dbGetTimeStamp(&prec->inp, &prec->time);
     return status;
 }

src/std/dev/devI64inSoftCallback.c

@@ -41,7 +41,7 @@ typedef struct devPvt {
     struct {
         DBRstatus
         DBRtime
-        epicsInt32 value;
+        epicsInt64 value;
     } buffer;
 } devPvt;
 
@@ -78,10 +78,11 @@ static long add_record(dbCommon *pcommon)
     devPvt *pdevPvt;
     processNotify *ppn;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
 
     if (plink->type != PV_LINK) {
-	long status = S_db_badField;
+        long status = S_db_badField;
 
         recGblRecordError(status, (void *)prec,
             "devI64inSoftCallback (add_record) Illegal INP field");
@@ -90,7 +91,7 @@ static long add_record(dbCommon *pcommon)
 
     chan = dbChannelCreate(plink->value.pv_link.pvname);
     if (!chan) {
-	long status = S_db_notFound;
+        long status = S_db_notFound;
 
         recGblRecordError(status, (void *)prec,
             "devI64inSoftCallback (init_record) linked record not found");
@@ -127,7 +128,9 @@ static long del_record(dbCommon *pcommon) {
     DBLINK *plink = &prec->inp;
     devPvt *pdevPvt = (devPvt *)prec->dpvt;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
+
     assert(plink->type == PN_LINK);
 
     dbNotifyCancel(&pdevPvt->pn);
@@ -150,21 +153,9 @@ static long init(int pass)
 
 static long init_record(int64inRecord *prec)
 {
-    /* INP must be CONSTANT or PN_LINK */
-    switch (prec->inp.type) {
-    case CONSTANT:
-        if (recGblInitConstantLink(&prec->inp, DBR_INT64, &prec->val))
-            prec->udf = FALSE;
-        break;
-    case PN_LINK:
-        /* Handled by add_record */
-        break;
-    default:
-        recGblRecordError(S_db_badField, (void *)prec,
-            "devI64inSoftCallback (init_record) Illegal INP field");
-        prec->pact = TRUE;
-        return S_db_badField;
-    }
+    if (recGblInitConstantLink(&prec->inp, DBR_INT64, &prec->val))
+        prec->udf = FALSE;
+
     return 0;
 }
 
@@ -205,9 +196,10 @@ static long read_int64in(int64inRecord *prec)
             break;
     }
 
-    if (prec->tsel.type == CONSTANT &&
+    if (dbLinkIsConstant(&prec->tsel) &&
         prec->tse == epicsTimeEventDeviceTime)
         prec->time = pdevPvt->buffer.time;
+
     return 0;
 }
 

src/std/dev/devI64outSoftCallback.c

@@ -28,19 +28,19 @@
 /* Create the dset for devI64outSoftCallback */
 static long write_int64out(int64outRecord *prec);
 struct {
-	long		number;
-	DEVSUPFUN	report;
-	DEVSUPFUN	init;
-	DEVSUPFUN	init_record;
-	DEVSUPFUN	get_ioint_info;
-	DEVSUPFUN	write_int64out;
+    long		number;
+    DEVSUPFUN	report;
+    DEVSUPFUN	init;
+    DEVSUPFUN	init_record;
+    DEVSUPFUN	get_ioint_info;
+    DEVSUPFUN	write_int64out;
 } devI64outSoftCallback = {
-	5,
-	NULL,
-	NULL,
-	NULL,
-	NULL,
-	write_int64out
+    5,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    write_int64out
 };
 epicsExportAddress(dset, devI64outSoftCallback);
 
@@ -52,18 +52,11 @@ static long write_int64out(int64outRecord *prec)
     if (prec->pact)
         return 0;
 
-    if (plink->type != CA_LINK) {
+    status = dbPutLinkAsync(plink, DBR_INT64, &prec->val, 1);
+    if (!status)
+        prec->pact = TRUE;
+    else if (status == S_db_noLSET)
         status = dbPutLink(plink, DBR_INT64, &prec->val, 1);
-        return status;
-    }
 
-    status = dbCaPutLinkCallback(plink, DBR_INT64, &prec->val, 1,
-        dbCaCallbackProcess, plink);
-    if (status) {
-        recGblSetSevr(prec, LINK_ALARM, INVALID_ALARM);
-        return status;
-    }
-
-    prec->pact = TRUE;
-    return 0;
+    return status;
 }

src/std/dev/devLiSoftCallback.c

@@ -4,7 +4,7 @@
 * Copyright (c) 2002 The Regents of the University of California, as
 *     Operator of Los Alamos National Laboratory.
 * EPICS BASE is distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
+* in file LICENSE that is included with this distribution.
 \*************************************************************************/
 /* devLiSoftCallback.c */
 /*
@@ -78,10 +78,11 @@ static long add_record(dbCommon *pcommon)
     devPvt *pdevPvt;
     processNotify *ppn;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
 
     if (plink->type != PV_LINK) {
-	long status = S_db_badField;
+        long status = S_db_badField;
 
         recGblRecordError(status, (void *)prec,
             "devLiSoftCallback (add_record) Illegal INP field");
@@ -90,7 +91,7 @@ static long add_record(dbCommon *pcommon)
 
     chan = dbChannelCreate(plink->value.pv_link.pvname);
     if (!chan) {
-	long status = S_db_notFound;
+        long status = S_db_notFound;
 
         recGblRecordError(status, (void *)prec,
             "devLiSoftCallback (init_record) linked record not found");
@@ -127,7 +128,9 @@ static long del_record(dbCommon *pcommon) {
     DBLINK *plink = &prec->inp;
     devPvt *pdevPvt = (devPvt *)prec->dpvt;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
+
     assert(plink->type == PN_LINK);
 
     dbNotifyCancel(&pdevPvt->pn);
@@ -150,21 +153,9 @@ static long init(int pass)
 
 static long init_record(longinRecord *prec)
 {
-    /* INP must be CONSTANT or PN_LINK */
-    switch (prec->inp.type) {
-    case CONSTANT:
-        if (recGblInitConstantLink(&prec->inp, DBR_LONG, &prec->val))
-            prec->udf = FALSE;
-        break;
-    case PN_LINK:
-        /* Handled by add_record */
-        break;
-    default:
-        recGblRecordError(S_db_badField, (void *)prec,
-            "devLiSoftCallback (init_record) Illegal INP field");
-        prec->pact = TRUE;
-        return S_db_badField;
-    }
+    if (recGblInitConstantLink(&prec->inp, DBR_LONG, &prec->val))
+        prec->udf = FALSE;
+
     return 0;
 }
 
@@ -205,9 +196,10 @@ static long read_li(longinRecord *prec)
             break;
     }
 
-    if (prec->tsel.type == CONSTANT &&
+    if (dbLinkIsConstant(&prec->tsel) &&
         prec->tse == epicsTimeEventDeviceTime)
         prec->time = pdevPvt->buffer.time;
+
     return 0;
 }
 

src/std/dev/devMbbiDirectSoftCallback.c

@@ -4,7 +4,7 @@
 * Copyright (c) 2002 The Regents of the University of California, as
 *     Operator of Los Alamos National Laboratory.
 * EPICS BASE is distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
+* in file LICENSE that is included with this distribution.
 \*************************************************************************/
 /* devMbbiDirectSoftCallback.c */
 /*
@@ -78,10 +78,11 @@ static long add_record(dbCommon *pcommon)
     devPvt *pdevPvt;
     processNotify *ppn;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
 
     if (plink->type != PV_LINK) {
-	long status = S_db_badField;
+        long status = S_db_badField;
 
         recGblRecordError(status, (void *)prec,
             "devMbbiDirectSoftCallback (add_record) Illegal INP field");
@@ -90,7 +91,7 @@ static long add_record(dbCommon *pcommon)
 
     chan = dbChannelCreate(plink->value.pv_link.pvname);
     if (!chan) {
-	long status = S_db_notFound;
+        long status = S_db_notFound;
 
         recGblRecordError(status,(void *)prec,
             "devMbbiDirectSoftCallback (add_record) linked record not found");
@@ -127,7 +128,9 @@ static long del_record(dbCommon *pcommon) {
     DBLINK *plink = &prec->inp;
     devPvt *pdevPvt = (devPvt *)prec->dpvt;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
+
     assert(plink->type == PN_LINK);
 
     dbNotifyCancel(&pdevPvt->pn);
@@ -150,21 +153,9 @@ static long init(int pass)
 
 static long init_record(mbbiDirectRecord *prec)
 {
-    /* INP must be CONSTANT or PN_LINK */
-    switch (prec->inp.type) {
-    case CONSTANT:
-        if (recGblInitConstantLink(&prec->inp, DBR_ENUM, &prec->val))
-            prec->udf = FALSE;
-        break;
-    case PN_LINK:
-        /* Handled by add_record */
-        break;
-    default:
-        recGblRecordError(S_db_badField, (void *)prec,
-            "devMbbiSoftCallback (init_record) Illegal INP field");
-        prec->pact = TRUE;
-        return S_db_badField;
-    }
+    if (recGblInitConstantLink(&prec->inp, DBR_ENUM, &prec->val))
+        prec->udf = FALSE;
+
     return 0;
 }
 
@@ -205,9 +196,10 @@ static long read_mbbiDirect(mbbiDirectRecord *prec)
             break;
     }
 
-    if (prec->tsel.type == CONSTANT &&
+    if (dbLinkIsConstant(&prec->tsel) &&
         prec->tse == epicsTimeEventDeviceTime)
         prec->time = pdevPvt->buffer.time;
+
     return 2;
 }
 

src/std/dev/devMbbiSoftCallback.c

@@ -4,7 +4,7 @@
 * Copyright (c) 2002 The Regents of the University of California, as
 *     Operator of Los Alamos National Laboratory.
 * EPICS BASE is distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
+* in file LICENSE that is included with this distribution.
 \*************************************************************************/
 /* devMbbiSoftCallback.c */
 /*
@@ -78,10 +78,11 @@ static long add_record(dbCommon *pcommon)
     devPvt *pdevPvt;
     processNotify *ppn;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
 
     if (plink->type != PV_LINK) {
-	long status = S_db_badField;
+        long status = S_db_badField;
 
         recGblRecordError(status, (void *)prec,
             "devMbbiSoftCallback (add_record) Illegal INP field");
@@ -90,7 +91,7 @@ static long add_record(dbCommon *pcommon)
 
     chan = dbChannelCreate(plink->value.pv_link.pvname);
     if (!chan) {
-	long status = S_db_notFound;
+        long status = S_db_notFound;
 
         recGblRecordError(status, (void *)prec,
             "devMbbiSoftCallback (add_record) linked record not found");
@@ -127,7 +128,9 @@ static long del_record(dbCommon *pcommon) {
     DBLINK *plink = &prec->inp;
     devPvt *pdevPvt = (devPvt *)prec->dpvt;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
+
     assert(plink->type == PN_LINK);
 
     dbNotifyCancel(&pdevPvt->pn);
@@ -150,21 +153,9 @@ static long init(int pass)
 
 static long init_record(mbbiRecord *prec)
 {
-    /* INP must be CONSTANT or PN_LINK */
-    switch (prec->inp.type) {
-    case CONSTANT:
-        if (recGblInitConstantLink(&prec->inp, DBR_ENUM, &prec->val))
-            prec->udf = FALSE;
-        break;
-    case PN_LINK:
-        /* Handled by add_record */
-        break;
-    default:
-        recGblRecordError(S_db_badField, (void *)prec,
-            "devMbbiSoftCallback (init_record) Illegal INP field");
-        prec->pact = TRUE;
-        return S_db_badField;
-    }
+    if (recGblInitConstantLink(&prec->inp, DBR_ENUM, &prec->val))
+        prec->udf = FALSE;
+
     return 0;
 }
 
@@ -205,9 +196,10 @@ static long read_mbbi(mbbiRecord *prec)
             break;
     }
 
-    if (prec->tsel.type == CONSTANT &&
+    if (dbLinkIsConstant(&prec->tsel) &&
         prec->tse == epicsTimeEventDeviceTime)
         prec->time = pdevPvt->buffer.time;
+
     return 2;
 }
 

src/std/dev/devSiSoftCallback.c

@@ -4,7 +4,7 @@
 * Copyright (c) 2002 The Regents of the University of California, as
 *     Operator of Los Alamos National Laboratory.
 * EPICS BASE is distributed subject to a Software License Agreement found
-* in file LICENSE that is included with this distribution. 
+* in file LICENSE that is included with this distribution.
 \*************************************************************************/
 /* devSiSoftCallback.c */
 /*
@@ -80,10 +80,11 @@ static long add_record(dbCommon *pcommon)
     devPvt *pdevPvt;
     processNotify *ppn;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
 
     if (plink->type != PV_LINK) {
-	long status = S_db_badField;
+        long status = S_db_badField;
 
         recGblRecordError(status, (void *)prec,
             "devSiSoftCallback (add_record) Illegal INP field");
@@ -92,7 +93,7 @@ static long add_record(dbCommon *pcommon)
 
     pdevPvt = calloc(1, sizeof(*pdevPvt));
     if (!pdevPvt) {
-	long status = S_db_noMemory;
+        long status = S_db_noMemory;
 
         recGblRecordError(status, (void *)prec,
             "devSiSoftCallback (add_record) out of memory, calloc() failed");
@@ -102,7 +103,7 @@ static long add_record(dbCommon *pcommon)
 
     chan = dbChannelCreate(plink->value.pv_link.pvname);
     if (!chan) {
-	long status = S_db_notFound;
+        long status = S_db_notFound;
 
         recGblRecordError(status, (void *)prec,
             "devSiSoftCallback (add_record) linked record not found");
@@ -129,7 +130,9 @@ static long del_record(dbCommon *pcommon) {
     DBLINK *plink = &prec->inp;
     devPvt *pdevPvt = (devPvt *)prec->dpvt;
 
-    if (plink->type == CONSTANT) return 0;
+    if (dbLinkIsDefined(plink) && dbLinkIsConstant(plink))
+        return 0;
+
     assert(plink->type == PN_LINK);
 
     dbNotifyCancel(&pdevPvt->pn);
@@ -152,21 +155,9 @@ static long init(int pass)
 
 static long init_record(stringinRecord *prec)
 {
-    /* INP must be CONSTANT or PN_LINK */
-    switch (prec->inp.type) {
-    case CONSTANT:
-        if (recGblInitConstantLink(&prec->inp, DBR_STRING, &prec->val))
-            prec->udf = FALSE;
-        break;
-    case PN_LINK:
-        /* Handled by add_record */
-        break;
-    default:
-        recGblRecordError(S_db_badField, (void *)prec,
-            "devSiSoftCallback (init_record) Illegal INP field");
-        prec->pact = TRUE;
-        return S_db_badField;
-    }
+    if (recGblInitConstantLink(&prec->inp, DBR_STRING, &prec->val))
+        prec->udf = FALSE;
+
     return 0;
 }
 
@@ -187,6 +178,7 @@ static long read_si(stringinRecord *prec)
         recGblSetSevr(prec, READ_ALARM, INVALID_ALARM);
         return pdevPvt->status;
     }
+
     strncpy(prec->val, pdevPvt->buffer.value, MAX_STRING_SIZE);
     prec->val[MAX_STRING_SIZE-1] = 0;
     prec->udf = FALSE;
@@ -207,9 +199,10 @@ static long read_si(stringinRecord *prec)
             break;
     }
 
-    if (prec->tsel.type == CONSTANT &&
+    if (dbLinkIsConstant(&prec->tsel) &&
         prec->tse == epicsTimeEventDeviceTime)
         prec->time = pdevPvt->buffer.time;
+
     return 0;
 }
 

src/std/rec/test/Makefile

@@ -4,7 +4,7 @@
 # Copyright (c) 2002 The Regents of the University of California, as
 #     Operator of Los Alamos National Laboratory.
 # EPICS BASE is distributed subject to a Software License Agreement found
-# in the file LICENSE that is included with this distribution. 
+# in the file LICENSE that is included with this distribution.
 #*************************************************************************
 TOP=../../../..
 
@@ -60,6 +60,13 @@ testHarness_SRCS += compressTest.c
 TESTFILES += ../compressTest.db
 TESTS += compressTest
 
+TESTPROD_HOST += asyncSoftTest
+asyncSoftTest_SRCS += asyncSoftTest.c
+asyncSoftTest_SRCS += recTestIoc_registerRecordDeviceDriver.cpp
+testHarness_SRCS += asyncSoftTest.c
+TESTFILES += ../asyncSoftTest.db
+TESTS += asyncSoftTest
+
 TARGETS += $(COMMON_DIR)/asTestIoc.dbd
 DBDDEPENDS_FILES += asTestIoc.dbd$(DEP)
 asTestIoc_DBD += base.dbd

src/std/rec/test/asyncSoftTest.c

@@ -0,0 +1,189 @@
+/*************************************************************************\
+* Copyright (c) 2017 UChicago Argonne LLC, as operator of Argonne
+* National Laboratory.
+* EPICS BASE is distributed subject to a Software License Agreement found
+* in file LICENSE that is included with this distribution.
+\*************************************************************************/
+
+#include <string.h>
+
+#include "dbAccess.h"
+#include "dbStaticLib.h"
+#include "dbTest.h"
+#include "dbUnitTest.h"
+#include "epicsEvent.h"
+#include "errlog.h"
+#include "registryFunction.h"
+#include "subRecord.h"
+#include "testMain.h"
+
+static int startCounter, doneCounter;
+static epicsEventId asyncEvent, doneEvent;
+
+static
+long asyncSubr(subRecord *prec)
+{
+    testDiag("Processing %s, pact=%d", prec->name, prec->pact);
+
+    if (!prec->pact) {
+        epicsEventTrigger(asyncEvent);
+        prec->pact = 1;     /* Make asynchronous */
+    }
+
+    return 0;
+}
+
+static
+long doneSubr(subRecord *prec)
+{
+    epicsEventTrigger(doneEvent);
+    return 0;
+}
+
+static
+void checkAsyncInput(const char *rec, int init, dbCommon *async)
+{
+    char inp[16], proc[16];
+
+    testDiag("Checking record '%s'", rec);
+
+    strcpy(inp, rec);
+    strcat(inp, ".INP");
+    strcpy(proc, rec);
+    strcat(proc, ".PROC");
+
+    if (init) {
+        testdbGetFieldEqual(rec, DBF_LONG, init);
+
+        testdbPutFieldOk(inp, DBF_STRING, "async");
+    }
+
+    testdbPutFieldOk(proc, DBF_CHAR, 1);
+
+    epicsEventWait(asyncEvent);
+    testdbGetFieldEqual("startCounter", DBF_LONG, ++startCounter);
+    testdbGetFieldEqual("doneCounter", DBF_LONG, doneCounter);
+
+    dbScanLock(async);
+    async->rset->process(async);
+    dbScanUnlock(async);
+
+    epicsEventWait(doneEvent);
+    testdbGetFieldEqual("startCounter", DBF_LONG, startCounter);
+    testdbGetFieldEqual("doneCounter", DBF_LONG, ++doneCounter);
+}
+
+static
+void testAsynInputs(dbCommon *async)
+{
+    const char * records[] = {
+        "ai0", "bi0", "di0", "ii0", "li0", "mi0", "si0", NULL,
+        "bi1",  /* bi1 must be first in this group */
+        "ai1", "di1", "ii1", "li1", "mi1", "si1", NULL,
+    };
+    const char ** rec = &records[0];
+    int init = 1;   /* bi1 initializes to 1 */
+
+    testDiag("============ Starting %s ============", EPICS_FUNCTION);
+
+    startCounter = doneCounter = 0;
+    testdbPutFieldOk("startCounter", DBF_LONG, startCounter);
+    testdbPutFieldOk("doneCounter", DBF_LONG, doneCounter);
+
+    epicsEventTryWait(asyncEvent);
+    epicsEventTryWait(doneEvent);
+
+    while (*rec) {  /* 1st group don't need initializing */
+        checkAsyncInput(*rec++, 0, async);
+    }
+    rec++;
+    while (*rec) {
+        checkAsyncInput(*rec++, init, async);
+        init = 9;   /* remainder initialize to 9 */
+    }
+
+    testDiag("============= Ending %s =============", EPICS_FUNCTION);
+}
+
+static
+void checkAsyncOutput(const char *rec, dbCommon *async)
+{
+    char proc[16];
+
+    testDiag("Checking record '%s'", rec);
+
+    strcpy(proc, rec);
+    strcat(proc, ".PROC");
+
+    testdbPutFieldOk(proc, DBF_CHAR, 1);
+
+    epicsEventWait(asyncEvent);
+    testdbGetFieldEqual("startCounter", DBF_LONG, ++startCounter);
+    testdbGetFieldEqual("doneCounter", DBF_LONG, doneCounter);
+
+    dbScanLock(async);
+    async->rset->process(async);
+    dbScanUnlock(async);
+
+    epicsEventWait(doneEvent);
+    testdbGetFieldEqual("startCounter", DBF_LONG, startCounter);
+    testdbGetFieldEqual("doneCounter", DBF_LONG, ++doneCounter);
+}
+
+static
+void testAsyncOutputs(dbCommon *async)
+{
+    const char * records[] = {
+        "ao1", "bo1", "do1", "io1", "lo1", "lso1", "mo1", "so1", NULL,
+    };
+    const char ** rec = &records[0];
+
+    testDiag("============ Starting %s ============", EPICS_FUNCTION);
+
+    startCounter = doneCounter = 0;
+    testdbPutFieldOk("startCounter", DBF_LONG, startCounter);
+    testdbPutFieldOk("doneCounter", DBF_LONG, doneCounter);
+
+    epicsEventTryWait(asyncEvent);
+    epicsEventTryWait(doneEvent);
+
+    while (*rec) {
+        checkAsyncOutput(*rec++, async);
+    }
+
+    testDiag("============= Ending %s =============", EPICS_FUNCTION);
+}
+
+void recTestIoc_registerRecordDeviceDriver(struct dbBase *);
+
+MAIN(asyncSoftTest)
+{
+    dbCommon *async;
+
+    testPlan(128);
+
+    testdbPrepare();
+    testdbReadDatabase("recTestIoc.dbd", NULL, NULL);
+
+    recTestIoc_registerRecordDeviceDriver(pdbbase);
+    registryFunctionAdd("asyncSubr", (REGISTRYFUNCTION) asyncSubr);
+    registryFunctionAdd("doneSubr", (REGISTRYFUNCTION) doneSubr);
+
+    testdbReadDatabase("asyncSoftTest.db", NULL, NULL);
+
+    eltc(0);
+    testIocInitOk();
+    eltc(1);
+
+    async = testdbRecordPtr("async");
+    asyncEvent = epicsEventCreate(epicsEventEmpty);
+    doneEvent = epicsEventCreate(epicsEventEmpty);
+
+    testAsynInputs(async);
+    testAsyncOutputs(async);
+
+    testIocShutdownOk();
+    testdbCleanup();
+
+    return testDone();
+}

src/std/rec/test/asyncSoftTest.db

@@ -0,0 +1,188 @@
+record(ai, "ai0") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, "async")
+  field(FLNK, "done")
+}
+record(bi, "bi0") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, "async")
+  field(FLNK, "done")
+  field(ZNAM, "Zero")
+  field(ONAM, "One")
+}
+record(int64in, "ii0") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, "async")
+  field(FLNK, "done")
+}
+record(longin, "li0") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, "async")
+  field(FLNK, "done")
+}
+record(mbbiDirect, "di0") {
+  field(DTYP, "Async Soft Channel")
+  field(NOBT, 4)
+  field(INP, "async")
+  field(FLNK, "done")
+}
+record(mbbi, "mi0") {
+  field(DTYP, "Async Soft Channel")
+  field(NOBT, 4)
+  field(INP, "async")
+  field(FLNK, "done")
+  field(ZRST, "Zero")
+  field(ONST, "One")
+  field(TWST, "Two")
+  field(THST, "Three")
+  field(FRST, "Four")
+  field(FVST, "Five")
+  field(SXST, "Six")
+  field(SVST, "Seven")
+  field(EIST, "Eight")
+  field(NIST, "Nine")
+  field(TEST, "Ten")
+  field(ELST, "Eleven")
+  field(TWST, "Twelve")
+  field(TTST, "Thirteen")
+  field(FTST, "Fourteen")
+  field(FFST, "Fifteen")
+}
+record(stringin, "si0") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, "async")
+  field(FLNK, "done")
+}
+
+record(ai, "ai1") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, {const:9})
+  field(FLNK, "done")
+}
+record(bi, "bi1") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, {const:1})
+  field(FLNK, "done")
+  field(ZNAM, "Zero")
+  field(ONAM, "One")
+}
+record(int64in, "ii1") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, {const:9})
+  field(FLNK, "done")
+}
+record(longin, "li1") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, {const:9})
+  field(FLNK, "done")
+}
+record(mbbiDirect, "di1") {
+  field(DTYP, "Async Soft Channel")
+  field(NOBT, 4)
+  field(INP, {const:9})
+  field(FLNK, "done")
+}
+record(mbbi, "mi1") {
+  field(DTYP, "Async Soft Channel")
+  field(NOBT, 4)
+  field(INP, {const:9})
+  field(FLNK, "done")
+  field(ZRST, "Zero")
+  field(ONST, "One")
+  field(TWST, "Two")
+  field(THST, "Three")
+  field(FRST, "Four")
+  field(FVST, "Five")
+  field(SXST, "Six")
+  field(SVST, "Seven")
+  field(EIST, "Eight")
+  field(NIST, "Nine")
+  field(TEST, "Ten")
+  field(ELST, "Eleven")
+  field(TWST, "Twelve")
+  field(TTST, "Thirteen")
+  field(FTST, "Fourteen")
+  field(FFST, "Fifteen")
+}
+record(stringin, "si1") {
+  field(DTYP, "Async Soft Channel")
+  field(INP, {const:"9"})
+  field(FLNK, "done")
+}
+
+record(sub, "async") {
+  field(INPA, "startCounter PP")
+  field(SNAM, "asyncSubr")
+}
+record(calc, "startCounter") {
+  field(CALC, "VAL+1")
+}
+record(sub, "done") {
+  field(INPA, "doneCounter PP")
+  field(SNAM, "doneSubr")
+}
+record(calc, "doneCounter") {
+  field(CALC, "VAL+1")
+}
+
+record(ao, "ao1") {
+  field(DTYP, "Async Soft Channel")
+  field(OUT, "async.PROC CA")
+  field(FLNK, "done")
+}
+record(bo, "bo1") {
+  field(DTYP, "Async Soft Channel")
+  field(OUT, "async.PROC CA")
+  field(FLNK, "done")
+  field(ZNAM, "Zero")
+  field(ONAM, "One")
+}
+record(int64out, "io1") {
+  field(DTYP, "Async Soft Channel")
+  field(OUT, "async.PROC CA")
+  field(FLNK, "done")
+}
+record(longout, "lo1") {
+  field(DTYP, "Async Soft Channel")
+  field(OUT, "async.PROC CA")
+  field(FLNK, "done")
+}
+record(mbboDirect, "do1") {
+  field(DTYP, "Async Soft Channel")
+  field(NOBT, 4)
+  field(OUT, "async.PROC CA")
+  field(FLNK, "done")
+}
+record(mbbo, "mo1") {
+  field(DTYP, "Async Soft Channel")
+  field(NOBT, 4)
+  field(OUT, "async.PROC CA")
+  field(FLNK, "done")
+  field(ZRST, "Zero")
+  field(ONST, "One")
+  field(TWST, "Two")
+  field(THST, "Three")
+  field(FRST, "Four")
+  field(FVST, "Five")
+  field(SXST, "Six")
+  field(SVST, "Seven")
+  field(EIST, "Eight")
+  field(NIST, "Nine")
+  field(TEST, "Ten")
+  field(ELST, "Eleven")
+  field(TWST, "Twelve")
+  field(TTST, "Thirteen")
+  field(FTST, "Fourteen")
+  field(FFST, "Fifteen")
+}
+record(lso, "lso1") {
+  field(DTYP, "Async Soft Channel")
+  field(OUT, "async.PROC CA")
+  field(FLNK, "done")
+  field(SIZV, 40)
+}
+record(stringout, "so1") {
+  field(DTYP, "Async Soft Channel")
+  field(OUT, "async.PROC CA")
+  field(FLNK, "done")
+}

src/std/rec/test/epicsRunRecordTests.c

@@ -19,6 +19,7 @@ int arrayOpTest(void);
 int asTest(void);
 int linkRetargetLinkTest(void);
 int linkInitTest(void);
+int asyncSoftTest(void);
 
 void epicsRunRecordTests(void)
 {
@@ -38,5 +39,7 @@ void epicsRunRecordTests(void)
 
     runTest(linkInitTest);
 
+    runTest(asyncSoftTest);
+
     epicsExit(0);   /* Trigger test harness */
 }

src/std/rec/test/linkInitTest.c

@@ -138,17 +138,23 @@ static void testArrayInputs()
 
     testdbGetFieldEqual("aai1.NORD", DBR_LONG, 10);
     testdbGetFieldEqual("aai1.UDF", DBR_UCHAR, 0);
+    testdbGetFieldEqual("aai2.NORD", DBR_LONG, 10);
+    testdbGetFieldEqual("aai2.UDF", DBR_UCHAR, 0);
     testdbGetFieldEqual("sa1.NORD", DBR_LONG, 10);
     testdbGetFieldEqual("sa1.UDF", DBR_UCHAR, 0);
     testdbGetFieldEqual("sa2.NORD", DBR_LONG, 0);
     testdbGetFieldEqual("sa2.UDF", DBR_UCHAR, 1);
     testdbGetFieldEqual("wf1.NORD", DBR_LONG, 10);
     testdbGetFieldEqual("wf1.UDF", DBR_UCHAR, 0);
+    testdbGetFieldEqual("wf2.NORD", DBR_LONG, 10);
+    testdbGetFieldEqual("wf2.UDF", DBR_UCHAR, 0);
 
     testdbGetArrFieldEqual("aai1.VAL", DBF_LONG, 12, 10, &oneToTwelve[0]);
+    testdbGetArrFieldEqual("aai2.VAL", DBF_LONG, 12, 10, &oneToTwelve[0]);
     testdbGetArrFieldEqual("sa1.VAL", DBF_LONG, 12, 10, &oneToTwelve[2]);
     testdbGetArrFieldEqual("sa2.VAL", DBF_LONG, 10, 0, NULL);
     testdbGetArrFieldEqual("wf1.VAL", DBF_LONG, 12, 10, &oneToTwelve[0]);
+    testdbGetArrFieldEqual("wf2.VAL", DBF_LONG, 12, 10, &oneToTwelve[0]);
 
     testdbPutFieldOk("sa1.INDX", DBF_LONG, 3);
     testdbGetArrFieldEqual("sa1.VAL", DBF_LONG, 12, 9, &oneToTwelve[3]);
@@ -159,6 +165,13 @@ static void testArrayInputs()
     testdbPutFieldOk("sa2.VAL", DBF_LONG, 1);
     testdbGetArrFieldEqual("sa2.VAL", DBF_LONG, 10, 1, &oneToTwelve[0]);
 
+    testDiag("testScalarInputs");
+
+    testdbGetFieldEqual("li1", DBR_LONG, 1);
+    testdbGetFieldEqual("i64i1", DBR_INT64, 1LL);
+    testdbGetFieldEqual("li2", DBR_LONG, 1);
+    testdbGetFieldEqual("i64i2", DBR_INT64, 1LL);
+
     testIocShutdownOk();
     testdbCleanup();
 }
@@ -200,7 +213,7 @@ static void testEventRecord()
 
 MAIN(linkInitTest)
 {
-    testPlan(62);
+    testPlan(72);
 
     testLongStringInit();
     testCalcInit();

src/std/rec/test/linkInitTest.db

@@ -31,11 +31,16 @@ record(printf, "printf2") {
   field(INP0, ["Longer test string, more that 40 characters long"])
 }
 
-record(waveform, "aai1") {
+record(aai, "aai1") {
   field(NELM, 10)
   field(FTVL, "LONG")
   field(INP, [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12])
 }
+record(aai, "aai2") {
+  field(NELM, 10)
+  field(FTVL, "LONG")
+  field(INP, {const:[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]})
+}
 record(subArray, "sa1") {
   field(FTVL, "LONG")
   field(MALM, 12)
@@ -53,6 +58,24 @@ record(waveform, "wf1") {
   field(FTVL, "LONG")
   field(INP, [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12])
 }
+record(waveform, "wf2") {
+  field(NELM, 10)
+  field(FTVL, "LONG")
+  field(INP, {const:[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]})
+}
+
+record(longin, "li1") {
+  field(INP, 1)
+}
+record(int64in, "i64i1") {
+  field(INP, 1)
+}
+record(longin, "li2") {
+  field(INP, {const:1})
+}
+record(int64in, "i64i2") {
+  field(INP, {const:1})
+}
 
 record(longin, "count1" ) {
   field(INP, {calc: {expr:"VAL+1"}})

src/tools/Makefile

@@ -47,6 +47,7 @@ PERL_SCRIPTS += makeTestfile.pl
 PERL_SCRIPTS += mkmf.pl
 PERL_SCRIPTS += munch.pl
 PERL_SCRIPTS += replaceVAR.pl
+PERL_SCRIPTS += tap-to-junit-xml.pl
 PERL_SCRIPTS += useManifestTool.pl
 PERL_SCRIPTS += genVersionHeader.pl
 

src/tools/tap-to-junit-xml.pl

@@ -0,0 +1,546 @@
+#!/usr/local/bin/perl
+=head1 NAME
+
+tap-to-junit-xml - convert perl-style TAP test output to JUnit-style XML
+
+=head1 SYNOPSIS
+
+tap-to-junit-xml [--help|--man]
+                [--[no]hidesummary]
+                [--input <tap input file>]
+                [--output <junit output file>]
+                [--puretap]
+                [<test suite name>] [outputprefix]
+
+=head1 DESCRIPTION
+
+Parse test suite output in TAP (Test Anything Protocol,
+C<http://testanything.org/>) format, and produce XML output in a similar format
+to that produced by the <junit> ant task.  This is useful for consumption by
+continuous-integration systems like Hudson (C<https://hudson.dev.java.net/>).
+
+C<"test suite name"> is a descriptive string used as the B<name> attribute on the
+top-level <testsuites> node of the output XML. Defaults to "make test".
+
+If C<outputprefix> is specified, multi-file output will be generated, with
+multiple XML files created using C<outputprefix> as the start of their
+filenames. The files are separated by testplan.  This option is ignored
+if --puretap is specified (TAP only allows one testplan per input file).
+This prefix may contain slashes, in which case the files will be
+placed into a directory hierarchy accordingly (although care should be taken to
+ensure these directories exist in advance).
+
+If --input I<file name> is not specified, STDIN will be read.
+If C<outputprefix> or --output is not specified, a single XML file will be
+generated on STDOUT.
+
+--output I<file name> is used to write a single XML file to I<file name>.
+
+--puretap parses a single TAP source and handles parse errors and directives
+(todo, skip, bailout).  --puretap ignores unknown (non-TAP) input. Without
+--puretap, the script will parse some additional non-TAP test input, such as
+Perl tests that can include a "Test Summary Report", but it won't generate
+correct XML unless the TAP testplan comes before the test cases.
+--hidesummary report (the default) will hide the summary report, --no-hidesummary
+will display it (neither has an effect when --puretap is specified).
+
+=head1 EXAMPLE
+
+    prove -v 2>&1 | tee tests.log
+    tap-to-junit-xml "make test" testxml/tests < tests.log
+
+(JUnit-formatted XML is now in "testxml/tests*.xml".)
+
+=head1 DEPENDENCIES
+
+ Getopt::Long
+ Pod::Usage
+ TAP::Parser
+ Time::HiRes
+ XML::Generator 
+
+=head1 BUGS
+
+ - Output is optimized for Hudson, and may not look quite as good in
+   other UIs.
+  - Doesn't do anything with the STDERR from tests.
+  - Doesn't fill in the 'errors' attribute in the  <testsuite> element.
+   (--puretap handles parse errors)
+ - Doesn't handle "todo" or "skip" (--puretap does)
+  - Doesn't get the elapsed time for each 'test' (i.e. assertion.)
+   (TAP output has no elapsed time convention).
+
+=head1 SOURCE
+
+http://github.com/jmason/tap-to-junit-xml/tree/master
+
+=head1 AUTHOR
+
+original, junit_xml.pl, by Matisse Enzer <matisse at matisse.net>; see
+C<http://twoalpha.blogspot.com/2007/01/junit-style-xml-from-perl-test-files.html>.
+
+pretty much entirely rewritten by Justin Mason <junit at jmason.org>, Feb 2008.
+
+Miscellaneous fixes and mods (--puretap) by Jascha Lee <jascha at yahoo-inc.com>, Mar 2009.
+
+=head1 VERSION
+
+ Mar 27 2008 jm
+ Mar 17 2009 jl
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2007 Matisse Enzer. All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+=cut
+
+use strict;
+use warnings;
+
+use Getopt::Long qw(:config no_ignore_case);
+use Pod::Usage;
+use TAP::Parser;
+use Time::HiRes qw(gettimeofday tv_interval);
+use XML::Generator qw(:noimport);
+
+my %opts;
+pod2usage() unless GetOptions( \%opts, 'help|h',
+                                      'hidesummary!',
+                                      'input=s',
+                                      'man',
+                                      'output=s',
+                                      'puretap'
+                            );
+
+pod2usage(-verbose => 1) if defined $opts{'help'};
+pod2usage(-verbose => 2) if defined $opts{'man'};
+
+my $opt_suitename = shift @ARGV;
+my $opt_multifile = 0;
+my $opt_mfprefix;
+
+if (defined $ARGV[0]) {
+  $opt_multifile = 1;
+  $opt_mfprefix = $ARGV[0];
+}
+
+# should the 'Test Summary Report' at the end of a test suite be displayed
+# as if it was a testcase?  in my opinion, no
+my $HIDE_TEST_SUMMARY_REPORT = defined $opts{'hidesummary'} ? $opts{'hidesummary'} : 1;
+
+my $suite_name = $opt_suitename || 'make test';
+my $safe_suite_name = $suite_name; $safe_suite_name =~ s/[^-:_A-Za-z0-9]+/_/gs;
+
+# TODO: it'd be nice to respect 'Universal desirable behavior #1' from
+# http://testanything.org/wiki/index.php/TAP_Consumers -- 'Should work on the
+# TAP as a stream (ie. as each line is received) rather than wait until all the
+# TAP is received'.   But it seems TAP::Parser itself doesn't support it!
+# maybe when TAP::Parser does that, we'll do it too.
+my $tapfh;
+if ( defined $opts{'input'} ) {
+   open $tapfh, '<', $opts{'input'} or die "Can't open TAP file '$opts{'input'}': $!\n";
+}
+else {
+   $tapfh = \*STDIN;
+}
+
+my $outfh;
+if ( defined $opts{'output'} ) {
+   open $outfh, '>', $opts{'output'} or die "Can't open output file '$opts{'output'}' for writing: $!\n";
+}
+else {
+   $outfh = \*STDOUT;
+}
+
+my $tap             = TAP::Parser->new( { source => $tapfh } );
+my $xmlgen          = XML::Generator->new( ':pretty');
+my $xmlgenunescaped = XML::Generator->new( escape      => 'unescaped',
+                                          conformance => 'strict',
+                                          pretty      => 2
+                                        );
+my @properties = _get_properties($xmlgen);
+if ( defined $opts{'puretap'} ) {
+   #
+   # Instead of trying to parse everything in one pass, which fails if the
+   # testplan is last, parse through the results for the test cases and
+   # then construct the <testsuite> information from the TAP and wrap it
+   # around the test cases. Ignore 'unknown' information.  [JL]
+   #
+   my @testcases = _parse_testcases( $tap, $xmlgen );
+   errorOut( $tap, $xmlgen ) if $tap->parse_errors;
+   print $outfh $xmlgen->testsuites(
+                   $xmlgen->testsuite( { name     => $safe_suite_name,
+                                         tests    => $tap->tests_planned,
+                                         failures => scalar $tap->failed,
+                                         errors   => 0,
+                                         time     => 0,
+                                         id       => 1 },
+                                         @testcases ));
+
+}
+else {
+   my $test_results    = _parse_tests( $tap, $xmlgen );
+   if ($opt_multifile) {
+  _gen_junit_multifile_xml( $xmlgen, \@properties, $test_results );
+   } else {
+       print $outfh _get_junit_xml( $xmlgen, \@properties, $test_results );
+   }
+}
+exit;
+
+#-------------------------------------------------------------------------------
+
+sub _get_junit_xml {
+  my ( $xmlgen, $properties, $test_results ) = @_;
+  my $xml = "<?xml version='1.0' encoding='UTF-8' ?>\n" . 
+          $xmlgen->testsuites({
+              name => $suite_name,
+            }, @$test_results);
+  return $xml;
+}
+
+sub _gen_junit_multifile_xml {
+  my ( $xmlgen, $properties, $test_results ) = @_;
+  my $count = 1;
+  foreach my $testsuite (@$test_results) {
+    open OUT, ">${opt_mfprefix}.${count}.xml"
+         or die "cannot write ${opt_mfprefix}.${count}.xml";
+    print OUT "<?xml version='1.0' encoding='UTF-8' ?>\n";
+    print OUT $testsuite;
+    close OUT;
+    $count++;
+  }
+}
+
+#
+# Wrap up parse errors and output them as test cases.
+#
+sub errorOut {
+   my $parser = shift;
+   my $xmlgen = shift;
+   die "errorOut() needs some args"  unless $parser and $xmlgen;
+   my ($xml, @errors, $name);
+   my $count = 1;
+   foreach my $error ( $parser->parse_errors ) {
+       $name = sprintf "%s%02d", 'Error_', $count++;
+       $xml  = $xmlgen->testcase( { name      => $name,
+                                    classname => 'TestsNotRun.ParseError',
+                                    time      => 0 },
+
+                   $xmlgen->error( { type    => 'TAPParseError',
+                                     message => $error } ));
+       push @errors, $xml;
+   }
+   print $outfh $xmlgen->testsuites(
+                   $xmlgen->testsuite( { name     => 'TestsNotRun.ParseError',
+                                         tests    => $tap->tests_planned,
+                                         failures => 0,
+                                         errors   => scalar $tap->parse_errors,
+                                         time     => 0,
+                                         id       => 1 },
+                                         @errors ));
+   exit 86;
+}
+
+#
+# Construct an array of XML'd test cases
+#
+sub _parse_testcases {
+   my $parser = shift;
+   my $xmlgen = shift;
+   return () unless $parser and $xmlgen;
+   my ($name, $directive, $xml, @testcases);
+
+   while ( my $result = $parser->next ) {
+       if ( $result->is_bailout ) {
+           $xml  = $xmlgen->testcase( { name      => 'BailOut',
+                                        classname => "$safe_suite_name.Tests",
+                                        time      => 0 },
+
+                       $xmlgen->error( { type    => 'BailOut',
+                                         message => $result->explanation } ));
+
+           push @testcases, $xml;
+           last;
+       }
+       next unless $result->is_test;
+       $directive = $result->directive;
+       $name = sprintf "%s%02d", 'Test_', $result->number;
+       $name .= "_$directive" if $directive;
+       if ( $result->is_ok ) {
+           $xml = $xmlgen->testcase( { name      => $name,
+                                       classname => "$safe_suite_name.Tests",
+                                       time      => 0 } );
+           push @testcases, $xml;
+       }
+       else {
+           $xml = $xmlgen->testcase( { name      => $name,
+                                       classname => "$safe_suite_name.Tests",
+                                       time      => 0 },
+                      $xmlgen->failure( { type    => 'TAPTestFailed',
+                                          message => $result->as_string } ));
+           push @testcases, $xml;
+       }
+   }
+
+   return @testcases;
+}
+
+sub _parse_tests {
+  my ( $parser, $xmlgen ) = @_;
+
+  my $ctx = {
+    testsuites => [ ],
+    test_name => 'notest',
+    plan_ntests => 0,
+    case_id => 0,
+  };
+
+  _new_ctx($ctx);
+
+  my $lastunk = '';
+
+  # unknown t/basic_lint.........
+  # plan 1..1
+  # comment # Running under perl version 5.008008 for linux
+  # comment # Current time local: Thu Jan 24 17:44:30 2008
+  # comment # Current time GMT:   Thu Jan 24 17:44:30 2008
+  # comment # Using Test.pm version 1.25
+  # unknown     /usr/bin/perl -T -w ../spamassassin.raw -C log/test_rules_copy  --siteconfigpath log/localrules.tmp -p log/test_default.cf  -L --lint
+  # unknown     Checking anything
+  # test ok 1
+  # test ok 2
+  # unknown t/basic_meta.........
+  # plan 1..2
+  # comment # Running under perl version 5.008008 for linux
+  # comment # Current time local: Thu Jan 24 17:44:31 2008
+  # comment # Current time GMT:   Thu Jan 24 17:44:31 2008
+  # comment # Using Test.pm version 1.25
+  # test not ok 1
+  # comment # Failed test 1 in t/basic_meta.t at line 91
+  # test ok 2
+  # unknown  Failed 1/2 subtests
+  # unknown t/basic_obj_api......
+  # plan 1..4
+  # comment # Running under perl version 5.008008 for linux
+  # comment # Current time local: Thu Jan 24 17:44:33 2008
+  # comment # Current time GMT:   Thu Jan 24 17:44:33 2008
+  # comment # Using Test.pm version 1.25
+  # test ok 1
+  # test ok 2
+  # test ok 3
+  # test ok 4
+  # test ok 9
+  # unknown
+  # unknown Test Summary Report
+  # unknown -------------------
+  # unknown t/basic_meta.t   (Wstat: 0 Tests: 2 Failed: 1)
+  # unknown   Failed test:  1
+  # unknown Files=3, Tests=7,  6 wallclock secs ( 0.01 usr  0.00 sys +  4.39 cusr  0.23 csys =  4.63 CPU)
+  # unknown Result: FAIL
+  # unknown Failed 1/3 test programs. 1/7 subtests failed.
+  # unknown make: *** [test_dynamic] Error 255
+
+  while ( my $r = $parser->next ) {
+    my $t = $r->type;
+    my $s = $r->as_string; $s =~ s/\s+$//;
+
+    # warn "JMD $t $s";
+
+    if ($t eq 'unknown') {
+      $lastunk = $s;
+
+      # PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(1, 'blib/lib', 'blib/arch')" t/basic_*
+      # if ($s =~ /test_harness\(.*?\)" (.+)$/) {
+      # $suite_name = $1;
+      # }
+      if ($s =~ /^Test Summary Report$/) {
+        # create a <testsuite> block for the summary
+        $ctx->{plan_ntests} = 0;
+        $ctx->{test_name} = "Test Summary Report";
+        $ctx->{case_tests} = 1;
+        _finish_test_block($ctx);
+      }
+      elsif ($s =~ /^Result: FAIL$/) {
+        $ctx->{case_tests}++;
+        $ctx->{case_failures}++;
+        my $test_case = {
+            classname => test_name_to_classname($ctx->{test_name}),
+            name      => 'result',
+            'time'    => 0,
+        };
+        my $failure = $xmlgen->failure({
+          type => "OverallTestsFailed",
+          message => $s
+        }, "__FAILUREMESSAGETODO__");
+
+        if (!$HIDE_TEST_SUMMARY_REPORT) {
+          push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case, $failure);
+        }
+      }
+      elsif ($s =~ /^(\S+?)\.\.\.+1\.\.(\d+?)\s*$/) {
+        # perl 5.6.x "Test" format plan line
+        # unknown t/basic_lint....................1..1
+
+        my ($name, $nt) = ($1,$2);
+        if ($ctx->{plan_ntests}) {       # only if there have been tests planned
+          _finish_test_block($ctx);
+        }
+
+        $ctx->{plan_ntests} = $nt+0;
+        $ctx->{test_name} = "$name.t";
+      }
+    }
+    elsif ($t eq 'plan') {
+      if ($ctx->{plan_ntests}) {       # only if there have been tests planned
+        _finish_test_block($ctx);
+      }
+
+      $ctx->{plan_ntests} = 0;
+      $s =~ /(\d+)$/ and $ctx->{plan_ntests} = $1+0;
+
+      $ctx->{test_name} = $lastunk;
+      $ctx->{test_name} =~ s/\.*\s*$//gs;
+      $ctx->{test_name} .= ".t";
+    }
+    elsif ($t eq 'test') {
+      my $ntest = 0;
+      if ($s =~ /(?:not |)\S+ (\d+)/) { $ntest = $1+0; }
+
+      if ($ntest > $ctx->{plan_ntests}) {
+        # jump in test numbers, more than planned; this is probably TAP::Parser's wierdness.
+        # (when it sees the "ok" line at the end of a test case with no number,
+        # it outputs the current total number of tests so far.)
+        next;
+      }
+
+      # clean this up in a Hudson-compatible way; ":" and "/" are out, "." also causes
+      # trouble by creating an extra "directory" in the results
+
+      my $test_case = {
+          classname => test_name_to_classname($ctx->{test_name}),
+          name      => sprintf("test %6d", $ntest), # space-padding ensures ordering
+          'time'    => 0,
+      };
+
+      $ctx->{case_tests}++;
+      my $failure = undef;
+      if ($s =~ /^not /i) {
+        $ctx->{case_failures}++;
+        $failure = $xmlgen->failure({
+          type => "TAPTestFailed",
+          message => $s
+        }, "__FAILUREMESSAGETODO__");
+        push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case, $failure);
+      }
+      else {
+        push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case);
+      }
+    }
+      
+    $ctx->{sysout} .= $s."\n";
+  }
+
+  if (scalar(@{$ctx->{test_cases}}) == 0 &&
+      scalar(@{$ctx->{testsuites}}) == 0)
+  { 
+    # no tests found! create a <testsuite> block containing *something* at least
+    $ctx->{case_tests}++;
+    my $test_case = {
+        classname => test_name_to_classname($ctx->{test_name}),
+        name      => 'result',
+        'time'    => 0,
+    };
+    push @{$ctx->{test_cases}}, $xmlgen->testcase($test_case);
+  }
+
+  _finish_test_block($ctx);
+  return $ctx->{testsuites};
+}
+
+sub _new_ctx {
+  my $ctx = shift;
+  $ctx->{start_time} = [gettimeofday];
+  $ctx->{test_cases} = [];
+  $ctx->{case_tests} = 0;
+  $ctx->{case_failures} = 0;
+  $ctx->{case_time} = 0;
+  $ctx->{case_id}++;
+  $ctx->{sysout} = '';
+  return $ctx;
+}
+
+sub _finish_test_block {
+  my $ctx = shift;
+  $ctx->{sysout} =~ s/\n\S+\.*\s*\n$/\n/s;       # remove next test's "t/foo....." line
+
+  my $elapsed_time = 0;     # TODO
+  #my $elapsed_time = tv_interval( $ctx->{start_time}, [gettimeofday] );
+
+  # clean it up to valid Java packagename format (or at least something Hudson will
+  # consume)
+  my $name = $ctx->{test_name};
+  $name =~ s/[^-:_A-Za-z0-9]+/_/gs;
+  $name = "$safe_suite_name.$name";      # a "directory" for the suite name
+
+  my $testsuite = {
+      'time'         => $elapsed_time,
+      'name'         => $name,
+      tests          => $ctx->{case_tests},
+      failures       => $ctx->{case_failures},
+      'id'           => $ctx->{case_id},
+      errors         => 0,
+  };
+
+  my @fixedcases = ();
+  foreach my $tc (@{$ctx->{test_cases}}) {
+    if ($tc =~ s/__FAILUREMESSAGETODO__/ cdata($ctx->{sysout}) /ges) {
+      push @fixedcases, \$tc;       # inhibits escaping!
+    } else {
+      push @fixedcases, $tc;
+    }
+  }
+
+  # use "unescaped"; we have already fixed escaping on these strings.
+  # note that a reference means 'this is unescaped', bizarrely.
+  push @{$ctx->{testsuites}}, $xmlgenunescaped->testsuite($testsuite,
+          @fixedcases,
+          \("<system-out>\n".cdata($ctx->{sysout})."\n</system-out>"),
+          \("<system-err />"));
+
+  _new_ctx($ctx);
+};
+
+sub cdata {
+  my $s = shift;
+  $s =~ s/\]\]>/\](warning: defanged by tap-to-junit-xml)\]>/gs;
+  return '<![CDATA['.$s.']]>';
+}
+
+sub _get_properties {
+    my $xmlgen = shift;
+    my @props;
+    foreach my $key ( sort keys %ENV ) {
+        push @props, $xmlgen->property( { name => "$key", value => $ENV{$key} } );
+    }
+    return @props;
+}
+
+sub test_name_to_classname {
+  my $safe = shift;
+  $safe =~ s/[^-:_A-Za-z0-9]+/_/gs;
+  $safe = "$safe_suite_name.$safe";      # a "directory" for the suite name
+  $safe;
+}
+
+__END__
+
+# JUnit references:
+# http://www.nabble.com/JUnit-4-XML-schematized--td13946472.html
+# http://jra1mw.cvs.cern.ch:8180/cgi-bin/jra1mw.cgi/org.glite.testing.unit/config/JUnitXSchema.xsd?view=markup
+# skipped tests:
+# https://hudson.dev.java.net/issues/show_bug.cgi?id=1251
+# Hudson source:
+# http://fisheye5.cenqua.com/browse/hudson/hudson/main/core/src/main/java/hudson/tasks/junit/CaseResult.java

src/tools/test/Breaktable.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 9;
 

src/tools/test/DBD.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 18;
 

src/tools/test/Device.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 16;
 

src/tools/test/Driver.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 2;
 

src/tools/test/Function.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 2;
 

src/tools/test/Menu.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 14;
 

src/tools/test/Recfield.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 76;
 

src/tools/test/Recordtype.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 17;
 

src/tools/test/Registrar.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 2;
 

src/tools/test/Variable.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 4;
 

src/tools/test/macLib.plt

@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 
-use FindBin qw($Bin);
-use lib "$Bin/../../../../lib/perl";
+use lib '../..';
 
 use Test::More tests => 35;