"Fossies" - the Fresh Open Source Software Archive

Member "PerlCDF38_0/testString2.pl" (19 Nov 2019, 3363 Bytes) of package /linux/misc/PerlCDF38_0.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl -w
    2 
    3 #
    4 # testPerlCDFii
    5 #
    6 #   This program tests the PerlCDF internal interface.  PerlCDF must be installed.
    7 #   See README.
    8 #
    9 #  Usage:
   10 #     perl testPerlCDFii.pl
   11 #
   12 # Written By:
   13 #
   14 #    Emily A. Greene
   15 #    NSSDC / Hughes STX
   16 #
   17 #    17 October, 1995
   18 #
   19 #    Version 1.0
   20 #    Modified by: Michael Liu  - 20 March, 1998
   21 #    Version 2.0
   22 #    Modified by: Michael Liu  - 07 January, 2005
   23 #
   24 #############################################################################
   25 #
   26 #  Translated from qst2ic.c v. 1.10 by J. Love
   27 #
   28 #  Differences include:
   29 #     z Variable is 5 strings each 8 characters long not a 40 character buffer
   30 #          tests changed accordingly
   31 #     maxiumum records written is a variable
   32 #     Arrays are all 1 Dimensional.  2 dimensionality handled within CDF.
   33 #     Added section confirming rVARs recCount, etc.
   34 #     Added a few informational messages
   35 #     Tests Epoch routines
   36 # Note: As Perl uses double, a variable of data type CDF_REAL4/FLOAT will 
   37 #   cause some minor value deviation due to different floating-point type 
   38 #   representations. If the value is returned from the CDF's C routine 
   39 #   and compared with Perl value, an epsilon is used for checkng their
   40 #   equality. 10**(-9) is used for double and 10**(-5) for 
   41 #   float/real. No problem for CDF_REAL8 data type.
   42 #     
   43 #############################################################################
   44 
   45 use strict;
   46 use Math::BigInt;
   47 
   48 BEGIN { unshift @INC,'/home/liu/PerlCDF38_0/blib/arch',
   49                      '/home/liu/PerlCDF38_0/blib/lib'; }
   50 use CDF;
   51 
   52 #############################################################################
   53 # Display title.
   54 #############################################################################
   55 
   56 print "\nTesting Perl-CDF Internal/C interface for strings\n\n";
   57 
   58 #############################################################################
   59 # Open CDF.
   60 #############################################################################
   61 my $id;
   62 my $status;
   63 
   64 $status = CDF::CDFlib (&OPEN_, &CDF_, $ARGV[0], \$id,
   65                &NULL_);
   66 QuitCDF ("4.0", $status) if ($status < &CDF_OK) ;
   67 
   68 #############################################################################
   69 # PUT to attributes.
   70 #############################################################################
   71 my @strings = ("abc", "12345", "a", "-1234");
   72 
   73 $status = CDF::CDFlib (&SELECT_, &ATTR_, 0,
   74                 &zVAR_, 0,
   75                 &zENTRY_, 0,
   76                &PUT_, &zENTRY_STRINGSDATA_, \@strings,
   77                &NULL_);
   78 QuitCDF ("13.0", $status) if ($status < &CDF_OK) ;
   79 
   80 $status = CDF::CDFlib (&CLOSE_, &CDF_,
   81                &NULL_);
   82 QuitCDF ("28.2", $status) if ($status < &CDF_OK) ;
   83 
   84 #############################################################################
   85 # Successful completion.
   86 #############################################################################
   87 print "All tests completed successfully\n";
   88 exit;
   89 
   90 #############################################################################
   91 # QuitCDF.
   92 #############################################################################
   93 sub QuitCDF {
   94     my ($where, $status)=@_;
   95 
   96   print "Aborting at $where ...\n";
   97   if ($status < &CDF_OK) {
   98     my $text;
   99     CDF::CDFlib (&SELECT_, &CDF_STATUS_, $status,
  100            &GET_, &STATUS_TEXT_, \$text,
  101            &NULL_);
  102     print $text;
  103   }
  104   CDF::CDFlib (&CLOSE_, &CDF_,
  105       &NULL_);
  106   print "...test aborted.\n";
  107   exit;
  108     
  109 }#endsub QuitCDF
  110