LCOV - code coverage report
Current view: top level - MICROCERN - fchtak.c (source / functions) Hit Total Coverage
Test: coverage.info Lines: 6 6 100.0 %
Date: 2016-06-14 17:26:59 Functions: 1 1 100.0 %

          Line data    Source code
       1             : /* $Id$ */
       2             : 
       3             : #include "kerngen/pilot.h"
       4             : /*>    ROUTINE FCHTAK
       5             :   CERN PROGLIB#         FCHTAK          .VERSION KERNFOR  4.31  911111
       6             :   ORIG. 22/02/91, JZ
       7             : 
       8             :       copy a Fortran character string
       9             :       to allocated memory zero-terminated,
      10             :       return the memory pointer
      11             : */
      12             : #include <stdio.h>
      13             : #include <stdlib.h>
      14             : #include "kerngen/fortchar.h"
      15             : char *fchtak(ftext,lgtext)
      16             : #if defined(CERNLIB_QMCRY)
      17             :       _fcd  ftext;
      18             : #endif
      19             : #if !defined(CERNLIB_QMCRY)
      20             :       char *ftext;
      21             : #endif
      22             :       int  lgtext;
      23             : {
      24             :   /*      char *malloc(); */
      25             :       char *ptalc, *ptuse;
      26             :       char *utext;
      27             :       int  nalc;
      28             :       int  ntx, jcol;
      29             : 
      30           2 :       nalc  = lgtext + 8;
      31           1 :       ptalc = (char*)malloc (nalc);
      32           1 :       if (ptalc == NULL)     goto exit;
      33             : #if defined(CERNLIB_QMCRY)
      34             :       utext = _fcdtocp(ftext);
      35             : #endif
      36             : #if !defined(CERNLIB_QMCRY)
      37             :       utext = ftext;
      38             : #endif
      39             : 
      40             :       ptuse = ptalc;
      41             :       ntx   = lgtext;
      42          22 :       for (jcol = 0; jcol < ntx; jcol++)  *ptuse++ = *utext++;
      43             : 
      44           1 :       *ptuse = '\0';
      45           1 : exit: return  ptalc;
      46             : }
      47             : /*> END <----------------------------------------------------------*/

Generated by: LCOV version 1.11