view release on metacpan or  search on metacpan

t/01-pptest.t  view on Meta::CPAN

  Pars => 'int [o] out()',
  OtherPars => '[io] NV_ADD1 v1; NV_HR v2; thing *ptr',
  GenericTypes => ['F'],
  Code => '$out() = $COMP(v1); $COMP(v1) = 8;',
);

pp_def('incomp_in',
  Pars => '[o] out()',
  OtherPars => 'pdl *ins[]',
  GenericTypes => ['F'],
  RedoDimsCode => <<'EOC',
pdl **ins = $COMP(ins);
PDL_Indx i;
for (i = 0; i < $COMP(ins_count); i++) {
  pdl *in = ins[i];
  PDL_RETERROR(PDL_err, PDL->make_physdims(in));
  if (in->ndims != 1)
    $CROAK("input ndarray %"IND_FLAG" has %"IND_FLAG" dims, not 1", i, in->ndims);
  if (!$PRIV(bvalflag) && (in->state & PDL_BADVAL)) $PRIV(bvalflag) = 1;
}
EOC
  Code => <<'EOC',
pdl **ins = $COMP(ins);
PDL_Indx i;
for (i = 0; i < $COMP(ins_count); i++)
  PDL_RETERROR(PDL_err, PDL->make_physical(ins[i]));
$out() = 0;
for (i = 0; i < $COMP(ins_count); i++) {
  pdl *in = ins[i];
  PDL_Indx j;
#define X_CAT_INNER(datatype_in, ctype_in, ppsym_in, ...) \
  PDL_DECLARE_PARAMETER_BADVAL(ctype_in, in, (in), 1, ppsym_in) \
  for(j=0; j<in->nvals; j++) { \
    if ($PRIV(bvalflag) && PDL_ISBAD2(in_datap[j], in_badval, ppsym_in, in_badval_isnan)) continue; \
    $out() += in_datap[j]; \
  }
  PDL_GENERICSWITCH(PDL_TYPELIST_ALL, in->datatype, X_CAT_INNER, $CROAK("Not a known data type code=%d", in->datatype))
#undef X_CAT_INNER
}
EOC
);

pp_def('incomp_out',
  Pars => 'in(n)',
  OtherPars => 'PDL_Indx howmany; [o] pdl *outs[]',
  GenericTypes => ['F'],
  HandleBad => 1,
  CallCopy => 0,
  GenericTypes => [PDL::Types::ppdefs_all()],
  Code => <<'EOC',
pdl **outs = malloc(($COMP(outs_count) = $COMP(howmany)) * sizeof(pdl*));
$COMP(outs) = outs;
PDL_Indx i, ndims = $PDL(in)->ndims, dims[ndims];
for (i = 0; i < ndims; i++) dims[i] = $PDL(in)->dims[i];
for (i = 0; i < $COMP(outs_count); i++) {
  pdl *o = outs[i] = PDL->pdlnew();
  if (!o) { for (i--; i >= 0; i--) PDL->destroy(outs[i]); free(outs); $CROAK("Failed to create ndarray"); }
  o->datatype = $PDL(in)->datatype;
  PDL_err = PDL->setdims(o, dims, ndims);
  if (PDL_err.error) { for (; i >= 0; i--) PDL->destroy(outs[i]); free(outs); return PDL_err; }
  PDL_err = PDL->allocdata(o);
  if (PDL_err.error) { for (; i >= 0; i--) PDL->destroy(outs[i]); free(outs); return PDL_err; }
  PDL_DECLARE_PARAMETER_BADVAL($GENERIC(in), o, (o), 1, $PPSYM(in))
  loop(n) %{ o_datap[n] = $in(); %}
}
EOC
);

pp_def('index_prec', # check $a(n=>x+1) works
  Pars => 'in(n); [o]out()',
  GenericTypes => ['F'],
  Code => 'loop (n) %{ if (n > 1) $out() += $in(n=>n-1); %}',
);

pp_def("diff_central",
  Pars => 'double x(); double [o] res();',
  GenericTypes => ['F'],
  OtherPars => 'SV* function;',
  Code => ';',
);

# previously in t/inline-comment-test.t
pp_addpm(pp_line_numbers(__LINE__-1, q{ sub myfunc { } }));

pp_def('testinc',
        Pars => 'a(); [o] b()',
        GenericTypes => ['F'],
        Code => q{
           /* emulate user debugging */
           /* Why doesn't this work???!!!! */
       threadloop %{
    /*         printf("  %f, %f\r", $a(), $b());
             printf("  Here\n");
        */
                 /* Sanity check */
                 $b() = $a() + 1;
         %}
        },
);

# make sure that if the word "broadcastloop" appears, later automatic broadcastloops
# will not be generated, even if the original broadcastloop was commented-out

pp_def('testinc2',
        Pars => 'a(); [o] b()',
        GenericTypes => ['F'],
        Code => q{
           /* emulate user debugging */
           /* Why doesn't this work???!!!! */
   /*    threadloop %{
             printf("  %f, %f\r", $a(), $b());
             printf("  Here\n");
         %}
        */
          /* Sanity check */
          $b() = $a() + 1;
        },
);

pp_def('or2',
  Pars => 'a(); b(); [o]c();',