1  #define FORTRANOBJECT_C
   2  #include "fortranobject.h"
   3  
   4  #ifdef __cplusplus
   5  extern "C" {
   6  #endif
   7  
   8  #include <stdarg.h>
   9  #include <stdlib.h>
  10  #include <string.h>
  11  
  12  /*
  13    This file implements: FortranObject, array_from_pyobj, copy_ND_array
  14  
  15    Author: Pearu Peterson <pearu@cens.ioc.ee>
  16    $Revision: 1.52 $
  17    $Date: 2005/07/11 07:44:20 $
  18  */
  19  
  20  int
  21  F2PyDict_SetItemString(PyObject *dict, char *name, PyObject *obj)
  22  {
  23      if (obj == NULL) {
  24          fprintf(stderr, "Error loading %s\n", name);
  25          if (PyErr_Occurred()) {
  26              PyErr_Print();
  27              PyErr_Clear();
  28          }
  29          return -1;
  30      }
  31      return PyDict_SetItemString(dict, name, obj);
  32  }
  33  
  34  /*
  35   * Python-only fallback for thread-local callback pointers
  36   */
  37  void *
  38  F2PySwapThreadLocalCallbackPtr(char *key, void *ptr)
  39  {
  40      PyObject *local_dict, *value;
  41      void *prev;
  42  
  43      local_dict = PyThreadState_GetDict();
  44      if (local_dict == NULL) {
  45          Py_FatalError(
  46                  "F2PySwapThreadLocalCallbackPtr: PyThreadState_GetDict "
  47                  "failed");
  48      }
  49  
  50      value = PyDict_GetItemString(local_dict, key);
  51      if (value != NULL) {
  52          prev = PyLong_AsVoidPtr(value);
  53          if (PyErr_Occurred()) {
  54              Py_FatalError(
  55                      "F2PySwapThreadLocalCallbackPtr: PyLong_AsVoidPtr failed");
  56          }
  57      }
  58      else {
  59          prev = NULL;
  60      }
  61  
  62      value = PyLong_FromVoidPtr((void *)ptr);
  63      if (value == NULL) {
  64          Py_FatalError(
  65                  "F2PySwapThreadLocalCallbackPtr: PyLong_FromVoidPtr failed");
  66      }
  67  
  68      if (PyDict_SetItemString(local_dict, key, value) != 0) {
  69          Py_FatalError(
  70                  "F2PySwapThreadLocalCallbackPtr: PyDict_SetItemString failed");
  71      }
  72  
  73      Py_DECREF(value);
  74  
  75      return prev;
  76  }
  77  
  78  void *
  79  F2PyGetThreadLocalCallbackPtr(char *key)
  80  {
  81      PyObject *local_dict, *value;
  82      void *prev;
  83  
  84      local_dict = PyThreadState_GetDict();
  85      if (local_dict == NULL) {
  86          Py_FatalError(
  87                  "F2PyGetThreadLocalCallbackPtr: PyThreadState_GetDict failed");
  88      }
  89  
  90      value = PyDict_GetItemString(local_dict, key);
  91      if (value != NULL) {
  92          prev = PyLong_AsVoidPtr(value);
  93          if (PyErr_Occurred()) {
  94              Py_FatalError(
  95                      "F2PyGetThreadLocalCallbackPtr: PyLong_AsVoidPtr failed");
  96          }
  97      }
  98      else {
  99          prev = NULL;
 100      }
 101  
 102      return prev;
 103  }
 104  
 105  static PyArray_Descr *
 106  get_descr_from_type_and_elsize(const int type_num, const int elsize)  {
 107    PyArray_Descr * descr = PyArray_DescrFromType(type_num);
 108    if (type_num == NPY_STRING) {
 109      // PyArray_DescrFromType returns descr with elsize = 0.
 110      PyArray_DESCR_REPLACE(descr);
 111      if (descr == NULL) {
 112        return NULL;
 113      }
 114      descr->elsize = elsize;
 115    }
 116    return descr;
 117  }
 118  
 119  /************************* FortranObject *******************************/
 120  
 121  typedef PyObject *(*fortranfunc)(PyObject *, PyObject *, PyObject *, void *);
 122  
 123  PyObject *
 124  PyFortranObject_New(FortranDataDef *defs, f2py_void_func init)
 125  {
 126      int i;
 127      PyFortranObject *fp = NULL;
 128      PyObject *v = NULL;
 129      if (init != NULL) { /* Initialize F90 module objects */
 130          (*(init))();
 131      }
 132      fp = PyObject_New(PyFortranObject, &PyFortran_Type);
 133      if (fp == NULL) {
 134          return NULL;
 135      }
 136      if ((fp->dict = PyDict_New()) == NULL) {
 137          Py_DECREF(fp);
 138          return NULL;
 139      }
 140      fp->len = 0;
 141      while (defs[fp->len].name != NULL) {
 142          fp->len++;
 143      }
 144      if (fp->len == 0) {
 145          goto fail;
 146      }
 147      fp->defs = defs;
 148      for (i = 0; i < fp->len; i++) {
 149          if (fp->defs[i].rank == -1) { /* Is Fortran routine */
 150              v = PyFortranObject_NewAsAttr(&(fp->defs[i]));
 151              if (v == NULL) {
 152                  goto fail;
 153              }
 154              PyDict_SetItemString(fp->dict, fp->defs[i].name, v);
 155              Py_XDECREF(v);
 156          }
 157          else if ((fp->defs[i].data) !=
 158                   NULL) { /* Is Fortran variable or array (not allocatable) */
 159              PyArray_Descr *
 160              descr = get_descr_from_type_and_elsize(fp->defs[i].type,
 161                                                     fp->defs[i].elsize);
 162              if (descr == NULL) {
 163                  goto fail;
 164              }
 165              v = PyArray_NewFromDescr(&PyArray_Type, descr, fp->defs[i].rank,
 166                                       fp->defs[i].dims.d, NULL, fp->defs[i].data,
 167                                       NPY_ARRAY_FARRAY, NULL);
 168              if (v == NULL) {
 169                  Py_DECREF(descr);
 170                  goto fail;
 171              }
 172              PyDict_SetItemString(fp->dict, fp->defs[i].name, v);
 173              Py_XDECREF(v);
 174          }
 175      }
 176      return (PyObject *)fp;
 177  fail:
 178      Py_XDECREF(fp);
 179      return NULL;
 180  }
 181  
 182  PyObject *
 183  PyFortranObject_NewAsAttr(FortranDataDef *defs)
 184  { /* used for calling F90 module routines */
 185      PyFortranObject *fp = NULL;
 186      fp = PyObject_New(PyFortranObject, &PyFortran_Type);
 187      if (fp == NULL)
 188          return NULL;
 189      if ((fp->dict = PyDict_New()) == NULL) {
 190          PyObject_Del(fp);
 191          return NULL;
 192      }
 193      fp->len = 1;
 194      fp->defs = defs;
 195      if (defs->rank == -1) {
 196        PyDict_SetItemString(fp->dict, "__name__", PyUnicode_FromFormat("function %s", defs->name));
 197      } else if (defs->rank == 0) {
 198        PyDict_SetItemString(fp->dict, "__name__", PyUnicode_FromFormat("scalar %s", defs->name));
 199      } else {
 200        PyDict_SetItemString(fp->dict, "__name__", PyUnicode_FromFormat("array %s", defs->name));
 201      }
 202      return (PyObject *)fp;
 203  }
 204  
 205  /* Fortran methods */
 206  
 207  static void
 208  fortran_dealloc(PyFortranObject *fp)
 209  {
 210      Py_XDECREF(fp->dict);
 211      PyObject_Del(fp);
 212  }
 213  
 214  /* Returns number of bytes consumed from buf, or -1 on error. */
 215  static Py_ssize_t
 216  format_def(char *buf, Py_ssize_t size, FortranDataDef def)
 217  {
 218      char *p = buf;
 219      int i;
 220      npy_intp n;
 221  
 222      n = PyOS_snprintf(p, size, "array(%" NPY_INTP_FMT, def.dims.d[0]);
 223      if (n < 0 || n >= size) {
 224          return -1;
 225      }
 226      p += n;
 227      size -= n;
 228  
 229      for (i = 1; i < def.rank; i++) {
 230          n = PyOS_snprintf(p, size, ",%" NPY_INTP_FMT, def.dims.d[i]);
 231          if (n < 0 || n >= size) {
 232              return -1;
 233          }
 234          p += n;
 235          size -= n;
 236      }
 237  
 238      if (size <= 0) {
 239          return -1;
 240      }
 241  
 242      *p++ = ')';
 243      size--;
 244  
 245      if (def.data == NULL) {
 246          static const char notalloc[] = ", not allocated";
 247          if ((size_t)size < sizeof(notalloc)) {
 248              return -1;
 249          }
 250          memcpy(p, notalloc, sizeof(notalloc));
 251          p += sizeof(notalloc);
 252          size -= sizeof(notalloc);
 253      }
 254  
 255      return p - buf;
 256  }
 257  
 258  static PyObject *
 259  fortran_doc(FortranDataDef def)
 260  {
 261      char *buf, *p;
 262      PyObject *s = NULL;
 263      Py_ssize_t n, origsize, size = 100;
 264  
 265      if (def.doc != NULL) {
 266          size += strlen(def.doc);
 267      }
 268      origsize = size;
 269      buf = p = (char *)PyMem_Malloc(size);
 270      if (buf == NULL) {
 271          return PyErr_NoMemory();
 272      }
 273  
 274      if (def.rank == -1) {
 275          if (def.doc) {
 276              n = strlen(def.doc);
 277              if (n > size) {
 278                  goto fail;
 279              }
 280              memcpy(p, def.doc, n);
 281              p += n;
 282              size -= n;
 283          }
 284          else {
 285              n = PyOS_snprintf(p, size, "%s - no docs available", def.name);
 286              if (n < 0 || n >= size) {
 287                  goto fail;
 288              }
 289              p += n;
 290              size -= n;
 291          }
 292      }
 293      else {
 294          PyArray_Descr *d = PyArray_DescrFromType(def.type);
 295          n = PyOS_snprintf(p, size, "%s : '%c'-", def.name, d->type);
 296          Py_DECREF(d);
 297          if (n < 0 || n >= size) {
 298              goto fail;
 299          }
 300          p += n;
 301          size -= n;
 302  
 303          if (def.data == NULL) {
 304              n = format_def(p, size, def);
 305              if (n < 0) {
 306                  goto fail;
 307              }
 308              p += n;
 309              size -= n;
 310          }
 311          else if (def.rank > 0) {
 312              n = format_def(p, size, def);
 313              if (n < 0) {
 314                  goto fail;
 315              }
 316              p += n;
 317              size -= n;
 318          }
 319          else {
 320              n = strlen("scalar");
 321              if (size < n) {
 322                  goto fail;
 323              }
 324              memcpy(p, "scalar", n);
 325              p += n;
 326              size -= n;
 327          }
 328      }
 329      if (size <= 1) {
 330          goto fail;
 331      }
 332      *p++ = '\n';
 333      size--;
 334  
 335      /* p now points one beyond the last character of the string in buf */
 336      s = PyUnicode_FromStringAndSize(buf, p - buf);
 337  
 338      PyMem_Free(buf);
 339      return s;
 340  
 341  fail:
 342      fprintf(stderr,
 343              "fortranobject.c: fortran_doc: len(p)=%zd>%zd=size:"
 344              " too long docstring required, increase size\n",
 345              p - buf, origsize);
 346      PyMem_Free(buf);
 347      return NULL;
 348  }
 349  
 350  static FortranDataDef *save_def; /* save pointer of an allocatable array */
 351  static void
 352  set_data(char *d, npy_intp *f)
 353  {           /* callback from Fortran */
 354      if (*f) /* In fortran f=allocated(d) */
 355          save_def->data = d;
 356      else
 357          save_def->data = NULL;
 358      /* printf("set_data: d=%p,f=%d\n",d,*f); */
 359  }
 360  
 361  static PyObject *
 362  fortran_getattr(PyFortranObject *fp, char *name)
 363  {
 364      int i, j, k, flag;
 365      if (fp->dict != NULL) {
 366          PyObject *v = _PyDict_GetItemStringWithError(fp->dict, name);
 367          if (v == NULL && PyErr_Occurred()) {
 368              return NULL;
 369          }
 370          else if (v != NULL) {
 371              Py_INCREF(v);
 372              return v;
 373          }
 374      }
 375      for (i = 0, j = 1; i < fp->len && (j = strcmp(name, fp->defs[i].name));
 376           i++)
 377          ;
 378      if (j == 0)
 379          if (fp->defs[i].rank != -1) { /* F90 allocatable array */
 380              if (fp->defs[i].func == NULL)
 381                  return NULL;
 382              for (k = 0; k < fp->defs[i].rank; ++k) fp->defs[i].dims.d[k] = -1;
 383              save_def = &fp->defs[i];
 384              (*(fp->defs[i].func))(&fp->defs[i].rank, fp->defs[i].dims.d,
 385                                    set_data, &flag);
 386              if (flag == 2)
 387                  k = fp->defs[i].rank + 1;
 388              else
 389                  k = fp->defs[i].rank;
 390              if (fp->defs[i].data != NULL) { /* array is allocated */
 391                  PyObject *v = PyArray_New(
 392                          &PyArray_Type, k, fp->defs[i].dims.d, fp->defs[i].type,
 393                          NULL, fp->defs[i].data, 0, NPY_ARRAY_FARRAY, NULL);
 394                  if (v == NULL)
 395                      return NULL;
 396                  /* Py_INCREF(v); */
 397                  return v;
 398              }
 399              else { /* array is not allocated */
 400                  Py_RETURN_NONE;
 401              }
 402          }
 403      if (strcmp(name, "__dict__") == 0) {
 404          Py_INCREF(fp->dict);
 405          return fp->dict;
 406      }
 407      if (strcmp(name, "__doc__") == 0) {
 408          PyObject *s = PyUnicode_FromString(""), *s2, *s3;
 409          for (i = 0; i < fp->len; i++) {
 410              s2 = fortran_doc(fp->defs[i]);
 411              s3 = PyUnicode_Concat(s, s2);
 412              Py_DECREF(s2);
 413              Py_DECREF(s);
 414              s = s3;
 415          }
 416          if (PyDict_SetItemString(fp->dict, name, s))
 417              return NULL;
 418          return s;
 419      }
 420      if ((strcmp(name, "_cpointer") == 0) && (fp->len == 1)) {
 421          PyObject *cobj =
 422                  F2PyCapsule_FromVoidPtr((void *)(fp->defs[0].data), NULL);
 423          if (PyDict_SetItemString(fp->dict, name, cobj))
 424              return NULL;
 425          return cobj;
 426      }
 427      PyObject *str, *ret;
 428      str = PyUnicode_FromString(name);
 429      ret = PyObject_GenericGetAttr((PyObject *)fp, str);
 430      Py_DECREF(str);
 431      return ret;
 432  }
 433  
 434  static int
 435  fortran_setattr(PyFortranObject *fp, char *name, PyObject *v)
 436  {
 437      int i, j, flag;
 438      PyArrayObject *arr = NULL;
 439      for (i = 0, j = 1; i < fp->len && (j = strcmp(name, fp->defs[i].name));
 440           i++)
 441          ;
 442      if (j == 0) {
 443          if (fp->defs[i].rank == -1) {
 444              PyErr_SetString(PyExc_AttributeError,
 445                              "over-writing fortran routine");
 446              return -1;
 447          }
 448          if (fp->defs[i].func != NULL) { /* is allocatable array */
 449              npy_intp dims[F2PY_MAX_DIMS];
 450              int k;
 451              save_def = &fp->defs[i];
 452              if (v != Py_None) { /* set new value (reallocate if needed --
 453                                     see f2py generated code for more
 454                                     details ) */
 455                  for (k = 0; k < fp->defs[i].rank; k++) dims[k] = -1;
 456                  if ((arr = array_from_pyobj(fp->defs[i].type, dims,
 457                                              fp->defs[i].rank, F2PY_INTENT_IN,
 458                                              v)) == NULL)
 459                      return -1;
 460                  (*(fp->defs[i].func))(&fp->defs[i].rank, PyArray_DIMS(arr),
 461                                        set_data, &flag);
 462              }
 463              else { /* deallocate */
 464                  for (k = 0; k < fp->defs[i].rank; k++) dims[k] = 0;
 465                  (*(fp->defs[i].func))(&fp->defs[i].rank, dims, set_data,
 466                                        &flag);
 467                  for (k = 0; k < fp->defs[i].rank; k++) dims[k] = -1;
 468              }
 469              memcpy(fp->defs[i].dims.d, dims,
 470                     fp->defs[i].rank * sizeof(npy_intp));
 471          }
 472          else { /* not allocatable array */
 473              if ((arr = array_from_pyobj(fp->defs[i].type, fp->defs[i].dims.d,
 474                                          fp->defs[i].rank, F2PY_INTENT_IN,
 475                                          v)) == NULL)
 476                  return -1;
 477          }
 478          if (fp->defs[i].data !=
 479              NULL) { /* copy Python object to Fortran array */
 480              npy_intp s = PyArray_MultiplyList(fp->defs[i].dims.d,
 481                                                PyArray_NDIM(arr));
 482              if (s == -1)
 483                  s = PyArray_MultiplyList(PyArray_DIMS(arr), PyArray_NDIM(arr));
 484              if (s < 0 || (memcpy(fp->defs[i].data, PyArray_DATA(arr),
 485                                   s * PyArray_ITEMSIZE(arr))) == NULL) {
 486                  if ((PyObject *)arr != v) {
 487                      Py_DECREF(arr);
 488                  }
 489                  return -1;
 490              }
 491              if ((PyObject *)arr != v) {
 492                  Py_DECREF(arr);
 493              }
 494          }
 495          else
 496              return (fp->defs[i].func == NULL ? -1 : 0);
 497          return 0; /* successful */
 498      }
 499      if (fp->dict == NULL) {
 500          fp->dict = PyDict_New();
 501          if (fp->dict == NULL)
 502              return -1;
 503      }
 504      if (v == NULL) {
 505          int rv = PyDict_DelItemString(fp->dict, name);
 506          if (rv < 0)
 507              PyErr_SetString(PyExc_AttributeError,
 508                              "delete non-existing fortran attribute");
 509          return rv;
 510      }
 511      else
 512          return PyDict_SetItemString(fp->dict, name, v);
 513  }
 514  
 515  static PyObject *
 516  fortran_call(PyFortranObject *fp, PyObject *arg, PyObject *kw)
 517  {
 518      int i = 0;
 519      /*  printf("fortran call
 520          name=%s,func=%p,data=%p,%p\n",fp->defs[i].name,
 521          fp->defs[i].func,fp->defs[i].data,&fp->defs[i].data); */
 522      if (fp->defs[i].rank == -1) { /* is Fortran routine */
 523          if (fp->defs[i].func == NULL) {
 524              PyErr_Format(PyExc_RuntimeError, "no function to call");
 525              return NULL;
 526          }
 527          else if (fp->defs[i].data == NULL)
 528              /* dummy routine */
 529              return (*((fortranfunc)(fp->defs[i].func)))((PyObject *)fp, arg,
 530                                                          kw, NULL);
 531          else
 532              return (*((fortranfunc)(fp->defs[i].func)))(
 533                      (PyObject *)fp, arg, kw, (void *)fp->defs[i].data);
 534      }
 535      PyErr_Format(PyExc_TypeError, "this fortran object is not callable");
 536      return NULL;
 537  }
 538  
 539  static PyObject *
 540  fortran_repr(PyFortranObject *fp)
 541  {
 542      PyObject *name = NULL, *repr = NULL;
 543      name = PyObject_GetAttrString((PyObject *)fp, "__name__");
 544      PyErr_Clear();
 545      if (name != NULL && PyUnicode_Check(name)) {
 546          repr = PyUnicode_FromFormat("<fortran %U>", name);
 547      }
 548      else {
 549          repr = PyUnicode_FromString("<fortran object>");
 550      }
 551      Py_XDECREF(name);
 552      return repr;
 553  }
 554  
 555  PyTypeObject PyFortran_Type = {
 556          PyVarObject_HEAD_INIT(NULL, 0).tp_name = "fortran",
 557          .tp_basicsize = sizeof(PyFortranObject),
 558          .tp_dealloc = (destructor)fortran_dealloc,
 559          .tp_getattr = (getattrfunc)fortran_getattr,
 560          .tp_setattr = (setattrfunc)fortran_setattr,
 561          .tp_repr = (reprfunc)fortran_repr,
 562          .tp_call = (ternaryfunc)fortran_call,
 563  };
 564  
 565  /************************* f2py_report_atexit *******************************/
 566  
 567  #ifdef F2PY_REPORT_ATEXIT
 568  static int passed_time = 0;
 569  static int passed_counter = 0;
 570  static int passed_call_time = 0;
 571  static struct timeb start_time;
 572  static struct timeb stop_time;
 573  static struct timeb start_call_time;
 574  static struct timeb stop_call_time;
 575  static int cb_passed_time = 0;
 576  static int cb_passed_counter = 0;
 577  static int cb_passed_call_time = 0;
 578  static struct timeb cb_start_time;
 579  static struct timeb cb_stop_time;
 580  static struct timeb cb_start_call_time;
 581  static struct timeb cb_stop_call_time;
 582  
 583  extern void
 584  f2py_start_clock(void)
 585  {
 586      ftime(&start_time);
 587  }
 588  extern void
 589  f2py_start_call_clock(void)
 590  {
 591      f2py_stop_clock();
 592      ftime(&start_call_time);
 593  }
 594  extern void
 595  f2py_stop_clock(void)
 596  {
 597      ftime(&stop_time);
 598      passed_time += 1000 * (stop_time.time - start_time.time);
 599      passed_time += stop_time.millitm - start_time.millitm;
 600  }
 601  extern void
 602  f2py_stop_call_clock(void)
 603  {
 604      ftime(&stop_call_time);
 605      passed_call_time += 1000 * (stop_call_time.time - start_call_time.time);
 606      passed_call_time += stop_call_time.millitm - start_call_time.millitm;
 607      passed_counter += 1;
 608      f2py_start_clock();
 609  }
 610  
 611  extern void
 612  f2py_cb_start_clock(void)
 613  {
 614      ftime(&cb_start_time);
 615  }
 616  extern void
 617  f2py_cb_start_call_clock(void)
 618  {
 619      f2py_cb_stop_clock();
 620      ftime(&cb_start_call_time);
 621  }
 622  extern void
 623  f2py_cb_stop_clock(void)
 624  {
 625      ftime(&cb_stop_time);
 626      cb_passed_time += 1000 * (cb_stop_time.time - cb_start_time.time);
 627      cb_passed_time += cb_stop_time.millitm - cb_start_time.millitm;
 628  }
 629  extern void
 630  f2py_cb_stop_call_clock(void)
 631  {
 632      ftime(&cb_stop_call_time);
 633      cb_passed_call_time +=
 634              1000 * (cb_stop_call_time.time - cb_start_call_time.time);
 635      cb_passed_call_time +=
 636              cb_stop_call_time.millitm - cb_start_call_time.millitm;
 637      cb_passed_counter += 1;
 638      f2py_cb_start_clock();
 639  }
 640  
 641  static int f2py_report_on_exit_been_here = 0;
 642  extern void
 643  f2py_report_on_exit(int exit_flag, void *name)
 644  {
 645      if (f2py_report_on_exit_been_here) {
 646          fprintf(stderr, "             %s\n", (char *)name);
 647          return;
 648      }
 649      f2py_report_on_exit_been_here = 1;
 650      fprintf(stderr, "                      /-----------------------\\\n");
 651      fprintf(stderr, "                     < F2PY performance report >\n");
 652      fprintf(stderr, "                      \\-----------------------/\n");
 653      fprintf(stderr, "Overall time spent in ...\n");
 654      fprintf(stderr, "(a) wrapped (Fortran/C) functions           : %8d msec\n",
 655              passed_call_time);
 656      fprintf(stderr, "(b) f2py interface,           %6d calls  : %8d msec\n",
 657              passed_counter, passed_time);
 658      fprintf(stderr, "(c) call-back (Python) functions            : %8d msec\n",
 659              cb_passed_call_time);
 660      fprintf(stderr, "(d) f2py call-back interface, %6d calls  : %8d msec\n",
 661              cb_passed_counter, cb_passed_time);
 662  
 663      fprintf(stderr,
 664              "(e) wrapped (Fortran/C) functions (actual) : %8d msec\n\n",
 665              passed_call_time - cb_passed_call_time - cb_passed_time);
 666      fprintf(stderr,
 667              "Use -DF2PY_REPORT_ATEXIT_DISABLE to disable this message.\n");
 668      fprintf(stderr, "Exit status: %d\n", exit_flag);
 669      fprintf(stderr, "Modules    : %s\n", (char *)name);
 670  }
 671  #endif
 672  
 673  /********************** report on array copy ****************************/
 674  
 675  #ifdef F2PY_REPORT_ON_ARRAY_COPY
 676  static void
 677  f2py_report_on_array_copy(PyArrayObject *arr)
 678  {
 679      const npy_intp arr_size = PyArray_Size((PyObject *)arr);
 680      if (arr_size > F2PY_REPORT_ON_ARRAY_COPY) {
 681          fprintf(stderr,
 682                  "copied an array: size=%ld, elsize=%" NPY_INTP_FMT "\n",
 683                  arr_size, (npy_intp)PyArray_ITEMSIZE(arr));
 684      }
 685  }
 686  static void
 687  f2py_report_on_array_copy_fromany(void)
 688  {
 689      fprintf(stderr, "created an array from object\n");
 690  }
 691  
 692  #define F2PY_REPORT_ON_ARRAY_COPY_FROMARR \
 693      f2py_report_on_array_copy((PyArrayObject *)arr)
 694  #define F2PY_REPORT_ON_ARRAY_COPY_FROMANY f2py_report_on_array_copy_fromany()
 695  #else
 696  #define F2PY_REPORT_ON_ARRAY_COPY_FROMARR
 697  #define F2PY_REPORT_ON_ARRAY_COPY_FROMANY
 698  #endif
 699  
 700  /************************* array_from_obj *******************************/
 701  
 702  /*
 703   * File: array_from_pyobj.c
 704   *
 705   * Description:
 706   * ------------
 707   * Provides array_from_pyobj function that returns a contiguous array
 708   * object with the given dimensions and required storage order, either
 709   * in row-major (C) or column-major (Fortran) order. The function
 710   * array_from_pyobj is very flexible about its Python object argument
 711   * that can be any number, list, tuple, or array.
 712   *
 713   * array_from_pyobj is used in f2py generated Python extension
 714   * modules.
 715   *
 716   * Author: Pearu Peterson <pearu@cens.ioc.ee>
 717   * Created: 13-16 January 2002
 718   * $Id: fortranobject.c,v 1.52 2005/07/11 07:44:20 pearu Exp $
 719   */
 720  
 721  static int check_and_fix_dimensions(const PyArrayObject* arr,
 722                                      const int rank,
 723                                      npy_intp *dims,
 724                                      const char *errmess);
 725  
 726  static int
 727  find_first_negative_dimension(const int rank, const npy_intp *dims)
 728  {
 729      for (int i = 0; i < rank; ++i) {
 730          if (dims[i] < 0) {
 731              return i;
 732          }
 733      }
 734      return -1;
 735  }
 736  
 737  #ifdef DEBUG_COPY_ND_ARRAY
 738  void
 739  dump_dims(int rank, npy_intp const *dims)
 740  {
 741      int i;
 742      printf("[");
 743      for (i = 0; i < rank; ++i) {
 744          printf("%3" NPY_INTP_FMT, dims[i]);
 745      }
 746      printf("]\n");
 747  }
 748  void
 749  dump_attrs(const PyArrayObject *obj)
 750  {
 751      const PyArrayObject_fields *arr = (const PyArrayObject_fields *)obj;
 752      int rank = PyArray_NDIM(arr);
 753      npy_intp size = PyArray_Size((PyObject *)arr);
 754      printf("\trank = %d, flags = %d, size = %" NPY_INTP_FMT "\n", rank,
 755             arr->flags, size);
 756      printf("\tstrides = ");
 757      dump_dims(rank, arr->strides);
 758      printf("\tdimensions = ");
 759      dump_dims(rank, arr->dimensions);
 760  }
 761  #endif
 762  
 763  #define SWAPTYPE(a, b, t) \
 764      {                     \
 765          t c;              \
 766          c = (a);          \
 767          (a) = (b);        \
 768          (b) = c;          \
 769      }
 770  
 771  static int
 772  swap_arrays(PyArrayObject *obj1, PyArrayObject *obj2)
 773  {
 774      PyArrayObject_fields *arr1 = (PyArrayObject_fields *)obj1,
 775                           *arr2 = (PyArrayObject_fields *)obj2;
 776      SWAPTYPE(arr1->data, arr2->data, char *);
 777      SWAPTYPE(arr1->nd, arr2->nd, int);
 778      SWAPTYPE(arr1->dimensions, arr2->dimensions, npy_intp *);
 779      SWAPTYPE(arr1->strides, arr2->strides, npy_intp *);
 780      SWAPTYPE(arr1->base, arr2->base, PyObject *);
 781      SWAPTYPE(arr1->descr, arr2->descr, PyArray_Descr *);
 782      SWAPTYPE(arr1->flags, arr2->flags, int);
 783      /* SWAPTYPE(arr1->weakreflist,arr2->weakreflist,PyObject*); */
 784      return 0;
 785  }
 786  
 787  #define ARRAY_ISCOMPATIBLE(arr,type_num)                                \
 788      ((PyArray_ISINTEGER(arr) && PyTypeNum_ISINTEGER(type_num)) ||     \
 789       (PyArray_ISFLOAT(arr) && PyTypeNum_ISFLOAT(type_num)) ||         \
 790       (PyArray_ISCOMPLEX(arr) && PyTypeNum_ISCOMPLEX(type_num)) ||     \
 791       (PyArray_ISBOOL(arr) && PyTypeNum_ISBOOL(type_num)) ||           \
 792       (PyArray_ISSTRING(arr) && PyTypeNum_ISSTRING(type_num)))
 793  
 794  static int
 795  get_elsize(PyObject *obj) {
 796    /*
 797      get_elsize determines array itemsize from a Python object.  Returns
 798      elsize if successful, -1 otherwise.
 799  
 800      Supported types of the input are: numpy.ndarray, bytes, str, tuple,
 801      list.
 802    */
 803  
 804    if (PyArray_Check(obj)) {
 805      return PyArray_DESCR((PyArrayObject *)obj)->elsize;
 806    } else if (PyBytes_Check(obj)) {
 807      return PyBytes_GET_SIZE(obj);
 808    } else if (PyUnicode_Check(obj)) {
 809      return PyUnicode_GET_LENGTH(obj);
 810    } else if (PySequence_Check(obj)) {
 811      PyObject* fast = PySequence_Fast(obj, "f2py:fortranobject.c:get_elsize");
 812      if (fast != NULL) {
 813        Py_ssize_t i, n = PySequence_Fast_GET_SIZE(fast);
 814        int sz, elsize = 0;
 815        for (i=0; i<n; i++) {
 816          sz = get_elsize(PySequence_Fast_GET_ITEM(fast, i) /* borrowed */);
 817          if (sz > elsize) {
 818            elsize = sz;
 819          }
 820        }
 821        Py_DECREF(fast);
 822        return elsize;
 823      }
 824    }
 825    return -1;
 826  }
 827  
 828  extern PyArrayObject *
 829  ndarray_from_pyobj(const int type_num,
 830                     const int elsize_,
 831                     npy_intp *dims,
 832                     const int rank,
 833                     const int intent,
 834                     PyObject *obj,
 835                     const char *errmess) {
 836      /*
 837       * Return an array with given element type and shape from a Python
 838       * object while taking into account the usage intent of the array.
 839       *
 840       * - element type is defined by type_num and elsize
 841       * - shape is defined by dims and rank
 842       *
 843       * ndarray_from_pyobj is used to convert Python object arguments
 844       * to numpy ndarrays with given type and shape that data is passed
 845       * to interfaced Fortran or C functions.
 846       *
 847       * errmess (if not NULL), contains a prefix of an error message
 848       * for an exception to be triggered within this function.
 849       *
 850       * Negative elsize value means that elsize is to be determined
 851       * from the Python object in runtime.
 852       *
 853       * Note on strings
 854       * ---------------
 855       *
 856       * String type (type_num == NPY_STRING) does not have fixed
 857       * element size and, by default, the type object sets it to
 858       * 0. Therefore, for string types, one has to use elsize
 859       * argument. For other types, elsize value is ignored.
 860       *
 861       * NumPy defines the type of a fixed-width string as
 862       * dtype('S<width>'). In addition, there is also dtype('c'), that
 863       * appears as dtype('S1') (these have the same type_num value),
 864       * but is actually different (.char attribute is either 'S' or
 865       * 'c', respecitely).
 866       *
 867       * In Fortran, character arrays and strings are different
 868       * concepts.  The relation between Fortran types, NumPy dtypes,
 869       * and type_num-elsize pairs, is defined as follows:
 870       *
 871       * character*5 foo     | dtype('S5')  | elsize=5, shape=()
 872       * character(5) foo    | dtype('S1')  | elsize=1, shape=(5)
 873       * character*5 foo(n)  | dtype('S5')  | elsize=5, shape=(n,)
 874       * character(5) foo(n) | dtype('S1')  | elsize=1, shape=(5, n)
 875       * character*(*) foo   | dtype('S')   | elsize=-1, shape=()
 876       *
 877       * Note about reference counting
 878       * -----------------------------
 879       *
 880       * If the caller returns the array to Python, it must be done with
 881       * Py_BuildValue("N",arr).  Otherwise, if obj!=arr then the caller
 882       * must call Py_DECREF(arr).
 883       *
 884       * Note on intent(cache,out,..)
 885       * ----------------------------
 886       * Don't expect correct data when returning intent(cache) array.
 887       *
 888       */
 889      char mess[F2PY_MESSAGE_BUFFER_SIZE];
 890      PyArrayObject *arr = NULL;
 891      int elsize = (elsize_ < 0 ? get_elsize(obj) : elsize_);
 892      if (elsize < 0) {
 893        if (errmess != NULL) {
 894          strcpy(mess, errmess);
 895        }
 896        sprintf(mess + strlen(mess),
 897                " -- failed to determine element size from %s",
 898                Py_TYPE(obj)->tp_name);
 899        PyErr_SetString(PyExc_SystemError, mess);
 900        return NULL;
 901      }
 902      PyArray_Descr * descr = get_descr_from_type_and_elsize(type_num, elsize);  // new reference
 903      if (descr == NULL) {
 904        return NULL;
 905      }
 906      elsize = descr->elsize;
 907      if ((intent & F2PY_INTENT_HIDE)
 908          || ((intent & F2PY_INTENT_CACHE) && (obj == Py_None))
 909          || ((intent & F2PY_OPTIONAL) && (obj == Py_None))
 910          ) {
 911          /* intent(cache), optional, intent(hide) */
 912          int ineg = find_first_negative_dimension(rank, dims);
 913          if (ineg >= 0) {
 914              int i;
 915              strcpy(mess, "failed to create intent(cache|hide)|optional array"
 916                     "-- must have defined dimensions but got (");
 917              for(i = 0; i < rank; ++i)
 918                  sprintf(mess + strlen(mess), "%" NPY_INTP_FMT ",", dims[i]);
 919              strcat(mess, ")");
 920              PyErr_SetString(PyExc_ValueError, mess);
 921              Py_DECREF(descr);
 922              return NULL;
 923          }
 924          arr = (PyArrayObject *)                                      \
 925            PyArray_NewFromDescr(&PyArray_Type, descr, rank, dims,
 926                                 NULL, NULL, !(intent & F2PY_INTENT_C), NULL);
 927          if (arr == NULL) {
 928            Py_DECREF(descr);
 929            return NULL;
 930          }
 931          if (PyArray_ITEMSIZE(arr) != elsize) {
 932            strcpy(mess, "failed to create intent(cache|hide)|optional array");
 933            sprintf(mess+strlen(mess)," -- expected elsize=%d got %" NPY_INTP_FMT, elsize, (npy_intp)PyArray_ITEMSIZE(arr));
 934            PyErr_SetString(PyExc_ValueError,mess);
 935            Py_DECREF(arr);
 936            return NULL;
 937          }
 938          if (!(intent & F2PY_INTENT_CACHE)) {
 939            PyArray_FILLWBYTE(arr, 0);
 940          }
 941          return arr;
 942      }
 943  
 944      if (PyArray_Check(obj)) {
 945          arr = (PyArrayObject *)obj;
 946          if (intent & F2PY_INTENT_CACHE) {
 947              /* intent(cache) */
 948              if (PyArray_ISONESEGMENT(arr)
 949                  && PyArray_ITEMSIZE(arr) >= elsize) {
 950                  if (check_and_fix_dimensions(arr, rank, dims, errmess)) {
 951                    Py_DECREF(descr);
 952                    return NULL;
 953                  }
 954                  if (intent & F2PY_INTENT_OUT)
 955                    Py_INCREF(arr);
 956                  Py_DECREF(descr);
 957                  return arr;
 958              }
 959              strcpy(mess, "failed to initialize intent(cache) array");
 960              if (!PyArray_ISONESEGMENT(arr))
 961                  strcat(mess, " -- input must be in one segment");
 962              if (PyArray_ITEMSIZE(arr) < elsize)
 963                  sprintf(mess + strlen(mess),
 964                          " -- expected at least elsize=%d but got "
 965                          "%" NPY_INTP_FMT,
 966                          elsize, (npy_intp)PyArray_ITEMSIZE(arr));
 967              PyErr_SetString(PyExc_ValueError, mess);
 968              Py_DECREF(descr);
 969              return NULL;
 970          }
 971  
 972          /* here we have always intent(in) or intent(inout) or intent(inplace)
 973           */
 974  
 975          if (check_and_fix_dimensions(arr, rank, dims, errmess)) {
 976            Py_DECREF(descr);
 977            return NULL;
 978          }
 979          /*
 980          printf("intent alignment=%d\n", F2PY_GET_ALIGNMENT(intent));
 981          printf("alignment check=%d\n", F2PY_CHECK_ALIGNMENT(arr, intent));
 982          int i;
 983          for (i=1;i<=16;i++)
 984            printf("i=%d isaligned=%d\n", i, ARRAY_ISALIGNED(arr, i));
 985          */
 986          if ((! (intent & F2PY_INTENT_COPY)) &&
 987              PyArray_ITEMSIZE(arr) == elsize &&
 988              ARRAY_ISCOMPATIBLE(arr,type_num) &&
 989              F2PY_CHECK_ALIGNMENT(arr, intent)) {
 990              if ((intent & F2PY_INTENT_INOUT || intent & F2PY_INTENT_INPLACE)
 991                ? ((intent & F2PY_INTENT_C) ? PyArray_ISCARRAY(arr) : PyArray_ISFARRAY(arr))
 992                : ((intent & F2PY_INTENT_C) ? PyArray_ISCARRAY_RO(arr) : PyArray_ISFARRAY_RO(arr))) {
 993                  if ((intent & F2PY_INTENT_OUT)) {
 994                      Py_INCREF(arr);
 995                  }
 996                  /* Returning input array */
 997                  Py_DECREF(descr);
 998                  return arr;
 999              }
1000          }
1001          if (intent & F2PY_INTENT_INOUT) {
1002              strcpy(mess, "failed to initialize intent(inout) array");
1003              /* Must use PyArray_IS*ARRAY because intent(inout) requires
1004               * writable input */
1005              if ((intent & F2PY_INTENT_C) && !PyArray_ISCARRAY(arr))
1006                  strcat(mess, " -- input not contiguous");
1007              if (!(intent & F2PY_INTENT_C) && !PyArray_ISFARRAY(arr))
1008                  strcat(mess, " -- input not fortran contiguous");
1009              if (PyArray_ITEMSIZE(arr) != elsize)
1010                  sprintf(mess + strlen(mess),
1011                          " -- expected elsize=%d but got %" NPY_INTP_FMT,
1012                          elsize,
1013                          (npy_intp)PyArray_ITEMSIZE(arr)
1014                          );
1015              if (!(ARRAY_ISCOMPATIBLE(arr, type_num))) {
1016                  sprintf(mess + strlen(mess),
1017                          " -- input '%c' not compatible to '%c'",
1018                          PyArray_DESCR(arr)->type, descr->type);
1019              }
1020              if (!(F2PY_CHECK_ALIGNMENT(arr, intent)))
1021                  sprintf(mess + strlen(mess), " -- input not %d-aligned",
1022                          F2PY_GET_ALIGNMENT(intent));
1023              PyErr_SetString(PyExc_ValueError, mess);
1024              Py_DECREF(descr);
1025              return NULL;
1026          }
1027  
1028          /* here we have always intent(in) or intent(inplace) */
1029  
1030          {
1031            PyArrayObject * retarr = (PyArrayObject *)                    \
1032              PyArray_NewFromDescr(&PyArray_Type, descr, PyArray_NDIM(arr), PyArray_DIMS(arr),
1033                                   NULL, NULL, !(intent & F2PY_INTENT_C), NULL);
1034            if (retarr==NULL) {
1035              Py_DECREF(descr);
1036              return NULL;
1037            }
1038            F2PY_REPORT_ON_ARRAY_COPY_FROMARR;
1039            if (PyArray_CopyInto(retarr, arr)) {
1040              Py_DECREF(retarr);
1041              return NULL;
1042            }
1043            if (intent & F2PY_INTENT_INPLACE) {
1044              if (swap_arrays(arr,retarr)) {
1045                Py_DECREF(retarr);
1046                return NULL; /* XXX: set exception */
1047              }
1048              Py_XDECREF(retarr);
1049              if (intent & F2PY_INTENT_OUT)
1050                Py_INCREF(arr);
1051            } else {
1052              arr = retarr;
1053            }
1054          }
1055          return arr;
1056      }
1057  
1058      if ((intent & F2PY_INTENT_INOUT) || (intent & F2PY_INTENT_INPLACE) ||
1059          (intent & F2PY_INTENT_CACHE)) {
1060          PyErr_Format(PyExc_TypeError,
1061                       "failed to initialize intent(inout|inplace|cache) "
1062                       "array, input '%s' object is not an array",
1063                       Py_TYPE(obj)->tp_name);
1064          Py_DECREF(descr);
1065          return NULL;
1066      }
1067  
1068      {
1069          F2PY_REPORT_ON_ARRAY_COPY_FROMANY;
1070          arr = (PyArrayObject *)PyArray_FromAny(
1071                  obj, descr, 0, 0,
1072                  ((intent & F2PY_INTENT_C) ? NPY_ARRAY_CARRAY
1073                                            : NPY_ARRAY_FARRAY) |
1074                          NPY_ARRAY_FORCECAST,
1075                  NULL);
1076          // Warning: in the case of NPY_STRING, PyArray_FromAny may
1077          // reset descr->elsize, e.g. dtype('S0') becomes dtype('S1').
1078          if (arr == NULL) {
1079            Py_DECREF(descr);
1080            return NULL;
1081          }
1082          if (type_num != NPY_STRING && PyArray_ITEMSIZE(arr) != elsize) {
1083            // This is internal sanity tests: elsize has been set to
1084            // descr->elsize in the beginning of this function.
1085            strcpy(mess, "failed to initialize intent(in) array");
1086            sprintf(mess + strlen(mess),
1087                    " -- expected elsize=%d got %" NPY_INTP_FMT, elsize,
1088                    (npy_intp)PyArray_ITEMSIZE(arr));
1089            PyErr_SetString(PyExc_ValueError, mess);
1090            Py_DECREF(arr);
1091            return NULL;
1092          }
1093          if (check_and_fix_dimensions(arr, rank, dims, errmess)) {
1094            Py_DECREF(arr);
1095            return NULL;
1096          }
1097          return arr;
1098      }
1099  }
1100  
1101  extern PyArrayObject *
1102  array_from_pyobj(const int type_num,
1103                                  npy_intp *dims,
1104                                  const int rank,
1105                                  const int intent,
1106                                  PyObject *obj) {
1107    /*
1108      Same as ndarray_from_pyobj but with elsize determined from type,
1109      if possible. Provided for backward compatibility.
1110     */
1111    PyArray_Descr* descr = PyArray_DescrFromType(type_num);
1112    int elsize = descr->elsize;
1113    Py_DECREF(descr);
1114    return ndarray_from_pyobj(type_num, elsize, dims, rank, intent, obj, NULL);
1115  }
1116  
1117  /*****************************************/
1118  /* Helper functions for array_from_pyobj */
1119  /*****************************************/
1120  
1121  static int
1122  check_and_fix_dimensions(const PyArrayObject* arr, const int rank,
1123                           npy_intp *dims, const char *errmess)
1124  {
1125      /*
1126       * This function fills in blanks (that are -1's) in dims list using
1127       * the dimensions from arr. It also checks that non-blank dims will
1128       * match with the corresponding values in arr dimensions.
1129       *
1130       * Returns 0 if the function is successful.
1131       *
1132       * If an error condition is detected, an exception is set and 1 is
1133       * returned.
1134       */
1135      char mess[F2PY_MESSAGE_BUFFER_SIZE];
1136      const npy_intp arr_size =
1137              (PyArray_NDIM(arr)) ? PyArray_Size((PyObject *)arr) : 1;
1138  #ifdef DEBUG_COPY_ND_ARRAY
1139      dump_attrs(arr);
1140      printf("check_and_fix_dimensions:init: dims=");
1141      dump_dims(rank, dims);
1142  #endif
1143      if (rank > PyArray_NDIM(arr)) { /* [1,2] -> [[1],[2]]; 1 -> [[1]]  */
1144          npy_intp new_size = 1;
1145          int free_axe = -1;
1146          int i;
1147          npy_intp d;
1148          /* Fill dims where -1 or 0; check dimensions; calc new_size; */
1149          for (i = 0; i < PyArray_NDIM(arr); ++i) {
1150              d = PyArray_DIM(arr, i);
1151              if (dims[i] >= 0) {
1152                  if (d > 1 && dims[i] != d) {
1153                      PyErr_Format(
1154                              PyExc_ValueError,
1155                              "%d-th dimension must be fixed to %" NPY_INTP_FMT
1156                              " but got %" NPY_INTP_FMT "\n",
1157                              i, dims[i], d);
1158                      return 1;
1159                  }
1160                  if (!dims[i])
1161                      dims[i] = 1;
1162              }
1163              else {
1164                  dims[i] = d ? d : 1;
1165              }
1166              new_size *= dims[i];
1167          }
1168          for (i = PyArray_NDIM(arr); i < rank; ++i)
1169              if (dims[i] > 1) {
1170                  PyErr_Format(PyExc_ValueError,
1171                               "%d-th dimension must be %" NPY_INTP_FMT
1172                               " but got 0 (not defined).\n",
1173                               i, dims[i]);
1174                  return 1;
1175              }
1176              else if (free_axe < 0)
1177                  free_axe = i;
1178              else
1179                  dims[i] = 1;
1180          if (free_axe >= 0) {
1181              dims[free_axe] = arr_size / new_size;
1182              new_size *= dims[free_axe];
1183          }
1184          if (new_size != arr_size) {
1185              PyErr_Format(PyExc_ValueError,
1186                           "unexpected array size: new_size=%" NPY_INTP_FMT
1187                           ", got array with arr_size=%" NPY_INTP_FMT
1188                           " (maybe too many free indices)\n",
1189                           new_size, arr_size);
1190              return 1;
1191          }
1192      }
1193      else if (rank == PyArray_NDIM(arr)) {
1194          npy_intp new_size = 1;
1195          int i;
1196          npy_intp d;
1197          for (i = 0; i < rank; ++i) {
1198              d = PyArray_DIM(arr, i);
1199              if (dims[i] >= 0) {
1200                  if (d > 1 && d != dims[i]) {
1201                      if (errmess != NULL) {
1202                          strcpy(mess, errmess);
1203                      }
1204                      sprintf(mess + strlen(mess),
1205                              " -- %d-th dimension must be fixed to %"
1206                              NPY_INTP_FMT " but got %" NPY_INTP_FMT,
1207                              i, dims[i], d);
1208                      PyErr_SetString(PyExc_ValueError, mess);
1209                      return 1;
1210                  }
1211                  if (!dims[i])
1212                      dims[i] = 1;
1213              }
1214              else
1215                  dims[i] = d;
1216              new_size *= dims[i];
1217          }
1218          if (new_size != arr_size) {
1219              PyErr_Format(PyExc_ValueError,
1220                           "unexpected array size: new_size=%" NPY_INTP_FMT
1221                           ", got array with arr_size=%" NPY_INTP_FMT "\n",
1222                           new_size, arr_size);
1223              return 1;
1224          }
1225      }
1226      else { /* [[1,2]] -> [[1],[2]] */
1227          int i, j;
1228          npy_intp d;
1229          int effrank;
1230          npy_intp size;
1231          for (i = 0, effrank = 0; i < PyArray_NDIM(arr); ++i)
1232              if (PyArray_DIM(arr, i) > 1)
1233                  ++effrank;
1234          if (dims[rank - 1] >= 0)
1235              if (effrank > rank) {
1236                  PyErr_Format(PyExc_ValueError,
1237                               "too many axes: %d (effrank=%d), "
1238                               "expected rank=%d\n",
1239                               PyArray_NDIM(arr), effrank, rank);
1240                  return 1;
1241              }
1242  
1243          for (i = 0, j = 0; i < rank; ++i) {
1244              while (j < PyArray_NDIM(arr) && PyArray_DIM(arr, j) < 2) ++j;
1245              if (j >= PyArray_NDIM(arr))
1246                  d = 1;
1247              else
1248                  d = PyArray_DIM(arr, j++);
1249              if (dims[i] >= 0) {
1250                  if (d > 1 && d != dims[i]) {
1251                      if (errmess != NULL) {
1252                          strcpy(mess, errmess);
1253                      }
1254                      sprintf(mess + strlen(mess),
1255                              " -- %d-th dimension must be fixed to %"
1256                              NPY_INTP_FMT " but got %" NPY_INTP_FMT
1257                              " (real index=%d)\n",
1258                              i, dims[i], d, j-1);
1259                      PyErr_SetString(PyExc_ValueError, mess);
1260                      return 1;
1261                  }
1262                  if (!dims[i])
1263                      dims[i] = 1;
1264              }
1265              else
1266                  dims[i] = d;
1267          }
1268  
1269          for (i = rank; i < PyArray_NDIM(arr);
1270               ++i) { /* [[1,2],[3,4]] -> [1,2,3,4] */
1271              while (j < PyArray_NDIM(arr) && PyArray_DIM(arr, j) < 2) ++j;
1272              if (j >= PyArray_NDIM(arr))
1273                  d = 1;
1274              else
1275                  d = PyArray_DIM(arr, j++);
1276              dims[rank - 1] *= d;
1277          }
1278          for (i = 0, size = 1; i < rank; ++i) size *= dims[i];
1279          if (size != arr_size) {
1280              char msg[200];
1281              int len;
1282              snprintf(msg, sizeof(msg),
1283                       "unexpected array size: size=%" NPY_INTP_FMT
1284                       ", arr_size=%" NPY_INTP_FMT
1285                       ", rank=%d, effrank=%d, arr.nd=%d, dims=[",
1286                       size, arr_size, rank, effrank, PyArray_NDIM(arr));
1287              for (i = 0; i < rank; ++i) {
1288                  len = strlen(msg);
1289                  snprintf(msg + len, sizeof(msg) - len, " %" NPY_INTP_FMT,
1290                           dims[i]);
1291              }
1292              len = strlen(msg);
1293              snprintf(msg + len, sizeof(msg) - len, " ], arr.dims=[");
1294              for (i = 0; i < PyArray_NDIM(arr); ++i) {
1295                  len = strlen(msg);
1296                  snprintf(msg + len, sizeof(msg) - len, " %" NPY_INTP_FMT,
1297                           PyArray_DIM(arr, i));
1298              }
1299              len = strlen(msg);
1300              snprintf(msg + len, sizeof(msg) - len, " ]\n");
1301              PyErr_SetString(PyExc_ValueError, msg);
1302              return 1;
1303          }
1304      }
1305  #ifdef DEBUG_COPY_ND_ARRAY
1306      printf("check_and_fix_dimensions:end: dims=");
1307      dump_dims(rank, dims);
1308  #endif
1309      return 0;
1310  }
1311  
1312  /* End of file: array_from_pyobj.c */
1313  
1314  /************************* copy_ND_array *******************************/
1315  
1316  extern int
1317  copy_ND_array(const PyArrayObject *arr, PyArrayObject *out)
1318  {
1319      F2PY_REPORT_ON_ARRAY_COPY_FROMARR;
1320      return PyArray_CopyInto(out, (PyArrayObject *)arr);
1321  }
1322  
1323  /********************* Various utility functions ***********************/
1324  
1325  extern int
1326  f2py_describe(PyObject *obj, char *buf) {
1327    /*
1328      Write the description of a Python object to buf. The caller must
1329      provide buffer with size sufficient to write the description.
1330  
1331      Return 1 on success.
1332    */
1333    char localbuf[F2PY_MESSAGE_BUFFER_SIZE];
1334    if (PyBytes_Check(obj)) {
1335      sprintf(localbuf, "%d-%s", (npy_int)PyBytes_GET_SIZE(obj), Py_TYPE(obj)->tp_name);
1336    } else if (PyUnicode_Check(obj)) {
1337      sprintf(localbuf, "%d-%s", (npy_int)PyUnicode_GET_LENGTH(obj), Py_TYPE(obj)->tp_name);
1338    } else if (PyArray_CheckScalar(obj)) {
1339      PyArrayObject* arr = (PyArrayObject*)obj;
1340      sprintf(localbuf, "%c%" NPY_INTP_FMT "-%s-scalar", PyArray_DESCR(arr)->kind, PyArray_ITEMSIZE(arr), Py_TYPE(obj)->tp_name);
1341    } else if (PyArray_Check(obj)) {
1342      int i;
1343      PyArrayObject* arr = (PyArrayObject*)obj;
1344      strcpy(localbuf, "(");
1345      for (i=0; i<PyArray_NDIM(arr); i++) {
1346        if (i) {
1347          strcat(localbuf, " ");
1348        }
1349        sprintf(localbuf + strlen(localbuf), "%" NPY_INTP_FMT ",", PyArray_DIM(arr, i));
1350      }
1351      sprintf(localbuf + strlen(localbuf), ")-%c%" NPY_INTP_FMT "-%s", PyArray_DESCR(arr)->kind, PyArray_ITEMSIZE(arr), Py_TYPE(obj)->tp_name);
1352    } else if (PySequence_Check(obj)) {
1353      sprintf(localbuf, "%d-%s", (npy_int)PySequence_Length(obj), Py_TYPE(obj)->tp_name);
1354    } else {
1355      sprintf(localbuf, "%s instance", Py_TYPE(obj)->tp_name);
1356    }
1357    // TODO: detect the size of buf and make sure that size(buf) >= size(localbuf).
1358    strcpy(buf, localbuf);
1359    return 1;
1360  }
1361  
1362  extern npy_intp
1363  f2py_size_impl(PyArrayObject* var, ...)
1364  {
1365    npy_intp sz = 0;
1366    npy_intp dim;
1367    npy_intp rank;
1368    va_list argp;
1369    va_start(argp, var);
1370    dim = va_arg(argp, npy_int);
1371    if (dim==-1)
1372      {
1373        sz = PyArray_SIZE(var);
1374      }
1375    else
1376      {
1377        rank = PyArray_NDIM(var);
1378        if (dim>=1 && dim<=rank)
1379          sz = PyArray_DIM(var, dim-1);
1380        else
1381          fprintf(stderr, "f2py_size: 2nd argument value=%" NPY_INTP_FMT
1382                  " fails to satisfy 1<=value<=%" NPY_INTP_FMT
1383                  ". Result will be 0.\n", dim, rank);
1384      }
1385    va_end(argp);
1386    return sz;
1387  }
1388  
1389  /*********************************************/
1390  /* Compatibility functions for Python >= 3.0 */
1391  /*********************************************/
1392  
1393  PyObject *
1394  F2PyCapsule_FromVoidPtr(void *ptr, void (*dtor)(PyObject *))
1395  {
1396      PyObject *ret = PyCapsule_New(ptr, NULL, dtor);
1397      if (ret == NULL) {
1398          PyErr_Clear();
1399      }
1400      return ret;
1401  }
1402  
1403  void *
1404  F2PyCapsule_AsVoidPtr(PyObject *obj)
1405  {
1406      void *ret = PyCapsule_GetPointer(obj, NULL);
1407      if (ret == NULL) {
1408          PyErr_Clear();
1409      }
1410      return ret;
1411  }
1412  
1413  int
1414  F2PyCapsule_Check(PyObject *ptr)
1415  {
1416      return PyCapsule_CheckExact(ptr);
1417  }
1418  
1419  #ifdef __cplusplus
1420  }
1421  #endif
1422  /************************* EOF fortranobject.c *******************************/