diff options
Diffstat (limited to 'numpy/f2py/src')
| -rw-r--r-- | numpy/f2py/src/fortranobject.c | 756 | ||||
| -rw-r--r-- | numpy/f2py/src/fortranobject.h | 123 | ||||
| -rw-r--r-- | numpy/f2py/src/test/Makefile | 96 | ||||
| -rw-r--r-- | numpy/f2py/src/test/bar.f | 11 | ||||
| -rw-r--r-- | numpy/f2py/src/test/foo.f | 11 | ||||
| -rw-r--r-- | numpy/f2py/src/test/foo90.f90 | 13 | ||||
| -rw-r--r-- | numpy/f2py/src/test/foomodule.c | 143 | ||||
| -rw-r--r-- | numpy/f2py/src/test/wrap.f | 70 |
8 files changed, 1223 insertions, 0 deletions
diff --git a/numpy/f2py/src/fortranobject.c b/numpy/f2py/src/fortranobject.c new file mode 100644 index 000000000..d5da43a88 --- /dev/null +++ b/numpy/f2py/src/fortranobject.c @@ -0,0 +1,756 @@ +#define FORTRANOBJECT_C +#include "fortranobject.h" + +#ifdef __cplusplus +extern "C" { +#endif +/* + This file implements: FortranObject, array_from_pyobj, copy_ND_array + + Author: Pearu Peterson <pearu@cens.ioc.ee> + $Revision: 1.52 $ + $Date: 2005/07/11 07:44:20 $ +*/ + +/************************* FortranObject *******************************/ + +typedef PyObject *(*fortranfunc)(PyObject *,PyObject *,PyObject *,void *); + +PyObject * +PyFortranObject_New(FortranDataDef* defs, f2py_void_func init) { + int i; + PyFortranObject *fp = NULL; + PyObject *v = NULL; + if (init!=NULL) /* Initialize F90 module objects */ + (*(init))(); + if ((fp = PyObject_New(PyFortranObject, &PyFortran_Type))==NULL) return NULL; + if ((fp->dict = PyDict_New())==NULL) return NULL; + fp->len = 0; + while (defs[fp->len].name != NULL) fp->len++; + if (fp->len == 0) goto fail; + fp->defs = defs; + for (i=0;i<fp->len;i++) + if (fp->defs[i].rank == -1) { /* Is Fortran routine */ + v = PyFortranObject_NewAsAttr(&(fp->defs[i])); + if (v==NULL) return NULL; + PyDict_SetItemString(fp->dict,fp->defs[i].name,v); + } else + if ((fp->defs[i].data)!=NULL) { /* Is Fortran variable or array (not allocatable) */ + v = PyArray_New(&PyArray_Type, fp->defs[i].rank, fp->defs[i].dims.d, + fp->defs[i].type, NULL, fp->defs[i].data, 0, FARRAY_FLAGS, + NULL); + if (v==NULL) return NULL; + PyDict_SetItemString(fp->dict,fp->defs[i].name,v); + } + Py_XDECREF(v); + return (PyObject *)fp; + fail: + Py_XDECREF(v); + return NULL; +} + +PyObject * +PyFortranObject_NewAsAttr(FortranDataDef* defs) { /* used for calling F90 module routines */ + PyFortranObject *fp = NULL; + fp = PyObject_New(PyFortranObject, &PyFortran_Type); + if (fp == NULL) return NULL; + if ((fp->dict = PyDict_New())==NULL) return NULL; + fp->len = 1; + fp->defs = defs; + return (PyObject *)fp; +} + +/* Fortran methods */ + +static void +fortran_dealloc(PyFortranObject *fp) { + Py_XDECREF(fp->dict); + PyMem_Del(fp); +} + + +static PyMethodDef fortran_methods[] = { + {NULL, NULL} /* sentinel */ +}; + + +static PyObject * +fortran_doc (FortranDataDef def) { + char *p; + PyObject *s = NULL; + int i; + unsigned size=100; + if (def.doc!=NULL) + size += strlen(def.doc); + p = (char*)malloc (size); + if (sprintf(p,"%s - ",def.name)==0) goto fail; + if (def.rank==-1) { + if (def.doc==NULL) { + if (sprintf(p,"%sno docs available",p)==0) + goto fail; + } else { + if (sprintf(p,"%s%s",p,def.doc)==0) + goto fail; + } + } else { + PyArray_Descr *d = PyArray_DescrFromType(def.type); + if (sprintf(p,"%s'%c'-",p,d->type)==0) goto fail; + if (def.data==NULL) { + if (sprintf(p,"%sarray(%" INTP_FMT,p,def.dims.d[0])==0) goto fail; + for(i=1;i<def.rank;++i) + if (sprintf(p,"%s,%" INTP_FMT,p,def.dims.d[i])==0) goto fail; + if (sprintf(p,"%s), not allocated",p)==0) goto fail; + } else { + if (def.rank>0) { + if (sprintf(p,"%sarray(%"INTP_FMT,p,def.dims.d[0])==0) goto fail; + for(i=1;i<def.rank;i++) + if (sprintf(p,"%s,%" INTP_FMT,p,def.dims.d[i])==0) goto fail; + if (sprintf(p,"%s)",p)==0) goto fail; + } else { + if (sprintf(p,"%sscalar",p)==0) goto fail; + } + } + } + if (sprintf(p,"%s\n",p)==0) goto fail; + if (strlen(p)>size) { + fprintf(stderr,"fortranobject.c:fortran_doc:len(p)=%zd>%d(size): too long doc string required, increase size\n",strlen(p),size); + goto fail; + } + s = PyString_FromString(p); + fail: + free(p); + return s; +} + +static FortranDataDef *save_def; /* save pointer of an allocatable array */ +static void set_data(char *d,intp *f) { /* callback from Fortran */ + if (*f) /* In fortran f=allocated(d) */ + save_def->data = d; + else + save_def->data = NULL; + /* printf("set_data: d=%p,f=%d\n",d,*f); */ +} + +static PyObject * +fortran_getattr(PyFortranObject *fp, char *name) { + int i,j,k,flag; + if (fp->dict != NULL) { + PyObject *v = PyDict_GetItemString(fp->dict, name); + if (v != NULL) { + Py_INCREF(v); + return v; + } + } + for (i=0,j=1;i<fp->len && (j=strcmp(name,fp->defs[i].name));i++); + if (j==0) + if (fp->defs[i].rank!=-1) { /* F90 allocatable array */ + if (fp->defs[i].func==NULL) return NULL; + for(k=0;k<fp->defs[i].rank;++k) + fp->defs[i].dims.d[k]=-1; + save_def = &fp->defs[i]; + (*(fp->defs[i].func))(&fp->defs[i].rank,fp->defs[i].dims.d,set_data,&flag); + if (flag==2) + k = fp->defs[i].rank + 1; + else + k = fp->defs[i].rank; + if (fp->defs[i].data !=NULL) { /* array is allocated */ + PyObject *v = PyArray_New(&PyArray_Type, k, fp->defs[i].dims.d, + fp->defs[i].type, NULL, fp->defs[i].data, 0, FARRAY_FLAGS, + NULL); + if (v==NULL) return NULL; + /* Py_INCREF(v); */ + return v; + } else { /* array is not allocated */ + Py_INCREF(Py_None); + return Py_None; + } + } + if (strcmp(name,"__dict__")==0) { + Py_INCREF(fp->dict); + return fp->dict; + } + if (strcmp(name,"__doc__")==0) { + PyObject *s = PyString_FromString(""); + for (i=0;i<fp->len;i++) + PyString_ConcatAndDel(&s,fortran_doc(fp->defs[i])); + if (PyDict_SetItemString(fp->dict, name, s)) + return NULL; + return s; + } + if ((strcmp(name,"_cpointer")==0) && (fp->len==1)) { + PyObject *cobj = PyCObject_FromVoidPtr((void *)(fp->defs[0].data),NULL); + if (PyDict_SetItemString(fp->dict, name, cobj)) + return NULL; + return cobj; + } + return Py_FindMethod(fortran_methods, (PyObject *)fp, name); +} + +static int +fortran_setattr(PyFortranObject *fp, char *name, PyObject *v) { + int i,j,flag; + PyArrayObject *arr = NULL; + for (i=0,j=1;i<fp->len && (j=strcmp(name,fp->defs[i].name));i++); + if (j==0) { + if (fp->defs[i].rank==-1) { + PyErr_SetString(PyExc_AttributeError,"over-writing fortran routine"); + return -1; + } + if (fp->defs[i].func!=NULL) { /* is allocatable array */ + intp dims[F2PY_MAX_DIMS]; + int k; + save_def = &fp->defs[i]; + if (v!=Py_None) { /* set new value (reallocate if needed -- + see f2py generated code for more + details ) */ + for(k=0;k<fp->defs[i].rank;k++) dims[k]=-1; + if ((arr = array_from_pyobj(fp->defs[i].type,dims,fp->defs[i].rank,F2PY_INTENT_IN,v))==NULL) + return -1; + (*(fp->defs[i].func))(&fp->defs[i].rank,arr->dimensions,set_data,&flag); + } else { /* deallocate */ + for(k=0;k<fp->defs[i].rank;k++) dims[k]=0; + (*(fp->defs[i].func))(&fp->defs[i].rank,dims,set_data,&flag); + for(k=0;k<fp->defs[i].rank;k++) dims[k]=-1; + } + memcpy(fp->defs[i].dims.d,dims,fp->defs[i].rank*sizeof(intp)); + } else { /* not allocatable array */ + if ((arr = array_from_pyobj(fp->defs[i].type,fp->defs[i].dims.d,fp->defs[i].rank,F2PY_INTENT_IN,v))==NULL) + return -1; + } + if (fp->defs[i].data!=NULL) { /* copy Python object to Fortran array */ + intp s = PyArray_MultiplyList(fp->defs[i].dims.d,arr->nd); + if (s==-1) + s = PyArray_MultiplyList(arr->dimensions,arr->nd); + if (s<0 || + (memcpy(fp->defs[i].data,arr->data,s*PyArray_ITEMSIZE(arr)))==NULL) { + if ((PyObject*)arr!=v) { + Py_DECREF(arr); + } + return -1; + } + if ((PyObject*)arr!=v) { + Py_DECREF(arr); + } + } else return (fp->defs[i].func==NULL?-1:0); + return 0; /* succesful */ + } + if (fp->dict == NULL) { + fp->dict = PyDict_New(); + if (fp->dict == NULL) + return -1; + } + if (v == NULL) { + int rv = PyDict_DelItemString(fp->dict, name); + if (rv < 0) + PyErr_SetString(PyExc_AttributeError,"delete non-existing fortran attribute"); + return rv; + } + else + return PyDict_SetItemString(fp->dict, name, v); +} + +static PyObject* +fortran_call(PyFortranObject *fp, PyObject *arg, PyObject *kw) { + int i = 0; + /* printf("fortran call + name=%s,func=%p,data=%p,%p\n",fp->defs[i].name, + fp->defs[i].func,fp->defs[i].data,&fp->defs[i].data); */ + if (fp->defs[i].rank==-1) {/* is Fortran routine */ + if ((fp->defs[i].func==NULL)) { + PyErr_Format(PyExc_RuntimeError, "no function to call"); + return NULL; + } + else if (fp->defs[i].data==NULL) + /* dummy routine */ + return (*((fortranfunc)(fp->defs[i].func)))((PyObject *)fp,arg,kw,NULL); + else + return (*((fortranfunc)(fp->defs[i].func)))((PyObject *)fp,arg,kw, + (void *)fp->defs[i].data); + } + PyErr_Format(PyExc_TypeError, "this fortran object is not callable"); + return NULL; +} + + +PyTypeObject PyFortran_Type = { + PyObject_HEAD_INIT(0) + 0, /*ob_size*/ + "fortran", /*tp_name*/ + sizeof(PyFortranObject), /*tp_basicsize*/ + 0, /*tp_itemsize*/ + /* methods */ + (destructor)fortran_dealloc, /*tp_dealloc*/ + 0, /*tp_print*/ + (getattrfunc)fortran_getattr, /*tp_getattr*/ + (setattrfunc)fortran_setattr, /*tp_setattr*/ + 0, /*tp_compare*/ + 0, /*tp_repr*/ + 0, /*tp_as_number*/ + 0, /*tp_as_sequence*/ + 0, /*tp_as_mapping*/ + 0, /*tp_hash*/ + (ternaryfunc)fortran_call, /*tp_call*/ +}; + +/************************* f2py_report_atexit *******************************/ + +#ifdef F2PY_REPORT_ATEXIT +static int passed_time = 0; +static int passed_counter = 0; +static int passed_call_time = 0; +static struct timeb start_time; +static struct timeb stop_time; +static struct timeb start_call_time; +static struct timeb stop_call_time; +static int cb_passed_time = 0; +static int cb_passed_counter = 0; +static int cb_passed_call_time = 0; +static struct timeb cb_start_time; +static struct timeb cb_stop_time; +static struct timeb cb_start_call_time; +static struct timeb cb_stop_call_time; + +extern void f2py_start_clock(void) { ftime(&start_time); } +extern +void f2py_start_call_clock(void) { + f2py_stop_clock(); + ftime(&start_call_time); +} +extern +void f2py_stop_clock(void) { + ftime(&stop_time); + passed_time += 1000*(stop_time.time - start_time.time); + passed_time += stop_time.millitm - start_time.millitm; +} +extern +void f2py_stop_call_clock(void) { + ftime(&stop_call_time); + passed_call_time += 1000*(stop_call_time.time - start_call_time.time); + passed_call_time += stop_call_time.millitm - start_call_time.millitm; + passed_counter += 1; + f2py_start_clock(); +} + +extern void f2py_cb_start_clock(void) { ftime(&cb_start_time); } +extern +void f2py_cb_start_call_clock(void) { + f2py_cb_stop_clock(); + ftime(&cb_start_call_time); +} +extern +void f2py_cb_stop_clock(void) { + ftime(&cb_stop_time); + cb_passed_time += 1000*(cb_stop_time.time - cb_start_time.time); + cb_passed_time += cb_stop_time.millitm - cb_start_time.millitm; +} +extern +void f2py_cb_stop_call_clock(void) { + ftime(&cb_stop_call_time); + cb_passed_call_time += 1000*(cb_stop_call_time.time - cb_start_call_time.time); + cb_passed_call_time += cb_stop_call_time.millitm - cb_start_call_time.millitm; + cb_passed_counter += 1; + f2py_cb_start_clock(); +} + +static int f2py_report_on_exit_been_here = 0; +extern +void f2py_report_on_exit(int exit_flag,void *name) { + if (f2py_report_on_exit_been_here) { + fprintf(stderr," %s\n",(char*)name); + return; + } + f2py_report_on_exit_been_here = 1; + fprintf(stderr," /-----------------------\\\n"); + fprintf(stderr," < F2PY performance report >\n"); + fprintf(stderr," \\-----------------------/\n"); + fprintf(stderr,"Overall time spent in ...\n"); + fprintf(stderr,"(a) wrapped (Fortran/C) functions : %8d msec\n", + passed_call_time); + fprintf(stderr,"(b) f2py interface, %6d calls : %8d msec\n", + passed_counter,passed_time); + fprintf(stderr,"(c) call-back (Python) functions : %8d msec\n", + cb_passed_call_time); + fprintf(stderr,"(d) f2py call-back interface, %6d calls : %8d msec\n", + cb_passed_counter,cb_passed_time); + + fprintf(stderr,"(e) wrapped (Fortran/C) functions (acctual) : %8d msec\n\n", + passed_call_time-cb_passed_call_time-cb_passed_time); + fprintf(stderr,"Use -DF2PY_REPORT_ATEXIT_DISABLE to disable this message.\n"); + fprintf(stderr,"Exit status: %d\n",exit_flag); + fprintf(stderr,"Modules : %s\n",(char*)name); +} +#endif + +/********************** report on array copy ****************************/ + +#ifdef F2PY_REPORT_ON_ARRAY_COPY +static void f2py_report_on_array_copy(PyArrayObject* arr) { + const long arr_size = PyArray_Size((PyObject *)arr); + if (arr_size>F2PY_REPORT_ON_ARRAY_COPY) { + fprintf(stderr,"copied an array: size=%ld, elsize=%d\n", + arr_size, PyArray_ITEMSIZE(arr)); + } +} +static void f2py_report_on_array_copy_fromany(void) { + fprintf(stderr,"created an array from object\n"); +} + +#define F2PY_REPORT_ON_ARRAY_COPY_FROMARR f2py_report_on_array_copy((PyArrayObject *)arr) +#define F2PY_REPORT_ON_ARRAY_COPY_FROMANY f2py_report_on_array_copy_fromany() +#else +#define F2PY_REPORT_ON_ARRAY_COPY_FROMARR +#define F2PY_REPORT_ON_ARRAY_COPY_FROMANY +#endif + + +/************************* array_from_obj *******************************/ + +/* + * File: array_from_pyobj.c + * + * Description: + * ------------ + * Provides array_from_pyobj function that returns a contigious array + * object with the given dimensions and required storage order, either + * in row-major (C) or column-major (Fortran) order. The function + * array_from_pyobj is very flexible about its Python object argument + * that can be any number, list, tuple, or array. + * + * array_from_pyobj is used in f2py generated Python extension + * modules. + * + * Author: Pearu Peterson <pearu@cens.ioc.ee> + * Created: 13-16 January 2002 + * $Id: fortranobject.c,v 1.52 2005/07/11 07:44:20 pearu Exp $ + */ + +static int +count_nonpos(const int rank, + const intp *dims) { + int i=0,r=0; + while (i<rank) { + if (dims[i] <= 0) ++r; + ++i; + } + return r; +} + +static int check_and_fix_dimensions(const PyArrayObject* arr, + const int rank, + intp *dims); + +#ifdef DEBUG_COPY_ND_ARRAY +void dump_attrs(const PyArrayObject* arr) { + int rank = arr->nd; + intp size = PyArray_Size((PyObject *)arr); + int i; + printf("\trank = %d, flags = %d, size = %" INTP_FMT "\n", + rank,arr->flags,size); + printf("\tstrides = ["); + for(i=0;i<rank;++i) { + printf("%3" INTP_FMT,arr->strides[i]); + } + printf("]\n\t dimensions = ["); + for(i=0;i<rank;++i) { + printf("%3" INTP_FMT, arr->dimensions[i]); + } + printf("]\n"); +} +#endif + +#define SWAPTYPE(a,b,t) {t c; c = (a); (a) = (b); (b) = c; } + +static int swap_arrays(PyArrayObject* arr1, PyArrayObject* arr2) { + SWAPTYPE(arr1->data,arr2->data,char*); + SWAPTYPE(arr1->nd,arr2->nd,int); + SWAPTYPE(arr1->dimensions,arr2->dimensions,intp*); + SWAPTYPE(arr1->strides,arr2->strides,intp*); + SWAPTYPE(arr1->base,arr2->base,PyObject*); + SWAPTYPE(arr1->descr,arr2->descr,PyArray_Descr*); + SWAPTYPE(arr1->flags,arr2->flags,int); + /* SWAPTYPE(arr1->weakreflist,arr2->weakreflist,PyObject*); */ + return 0; +} + +#define ARRAY_ISCOMPATIBLE(arr,type_num) \ +( (PyArray_ISINTEGER(arr) && PyTypeNum_ISINTEGER(type_num)) \ + ||(PyArray_ISFLOAT(arr) && PyTypeNum_ISFLOAT(type_num)) \ + ||(PyArray_ISCOMPLEX(arr) && PyTypeNum_ISCOMPLEX(type_num)) \ +) + +extern +PyArrayObject* array_from_pyobj(const int type_num, + intp *dims, + const int rank, + const int intent, + PyObject *obj) { + /* Note about reference counting + ----------------------------- + If the caller returns the array to Python, it must be done with + Py_BuildValue("N",arr). + Otherwise, if obj!=arr then the caller must call Py_DECREF(arr). + + Note on intent(cache,out,..) + --------------------- + Don't expect correct data when returning intent(cache) array. + + */ + char mess[200]; + PyArrayObject *arr = NULL; + PyArray_Descr *descr = PyArray_DescrFromType(type_num); + + if ((intent & F2PY_INTENT_HIDE) + || ((intent & F2PY_INTENT_CACHE) && (obj==Py_None)) + || ((intent & F2PY_OPTIONAL) && (obj==Py_None)) + ) { + /* intent(cache), optional, intent(hide) */ + if (count_nonpos(rank,dims)) { + int i; + sprintf(mess,"failed to create intent(cache|hide)|optional array" + "-- must have defined dimensions but got ("); + for(i=0;i<rank;++i) + sprintf(mess+strlen(mess),"%" INTP_FMT ",",dims[i]); + sprintf(mess+strlen(mess),")"); + PyErr_SetString(PyExc_ValueError,mess); + return NULL; + } + arr = (PyArrayObject *) + PyArray_New(&PyArray_Type, rank, dims, type_num, + NULL,NULL,0, + !(intent&F2PY_INTENT_C), + NULL); + if (!(intent & F2PY_INTENT_CACHE)) + PyArray_FILLWBYTE(arr, 0); + return arr; + } + + if (PyArray_Check(obj)) { + arr = (PyArrayObject *)obj; + + if (intent & F2PY_INTENT_CACHE) { + /* intent(cache) */ + if (PyArray_ISONESEGMENT(obj) + && PyArray_ITEMSIZE((PyArrayObject *)obj)>=descr->elsize) { + if (check_and_fix_dimensions((PyArrayObject *)obj,rank,dims)) + return NULL; /*XXX: set exception */ + if (intent & F2PY_INTENT_OUT) + Py_INCREF(obj); + return (PyArrayObject *)obj; + } + sprintf(mess,"failed to initialize intent(cache) array"); + if (!PyArray_ISONESEGMENT(obj)) + sprintf(mess+strlen(mess)," -- input must be in one segment"); + if (PyArray_ITEMSIZE(arr)<descr->elsize) + sprintf(mess+strlen(mess)," -- expected at least elsize=%d but got %d", + descr->elsize,PyArray_ITEMSIZE(arr) + ); + PyErr_SetString(PyExc_ValueError,mess); + return NULL; + } + + /* here we have always intent(in) or intent(inout) or intent(inplace) */ + + if (check_and_fix_dimensions(arr,rank,dims)) + return NULL; /*XXX: set exception */ + + if ((! (intent & F2PY_INTENT_COPY)) + && PyArray_ITEMSIZE(arr)==descr->elsize + && ARRAY_ISCOMPATIBLE(arr,type_num) + ) { + if ((intent & F2PY_INTENT_C)?PyArray_ISCARRAY(arr):PyArray_ISFARRAY(arr)) { + if ((intent & F2PY_INTENT_OUT)) { + Py_INCREF(arr); + } + /* Returning input array */ + return arr; + } + } + + if (intent & F2PY_INTENT_INOUT) { + sprintf(mess,"failed to initialize intent(inout) array"); + if ((intent & F2PY_INTENT_C) && !PyArray_ISCARRAY(arr)) + sprintf(mess+strlen(mess)," -- input not contiguous"); + if (!(intent & F2PY_INTENT_C) && !PyArray_ISFARRAY(arr)) + sprintf(mess+strlen(mess)," -- input not fortran contiguous"); + if (PyArray_ITEMSIZE(arr)!=descr->elsize) + sprintf(mess+strlen(mess)," -- expected elsize=%d but got %d", + descr->elsize, + PyArray_ITEMSIZE(arr) + ); + if (!(ARRAY_ISCOMPATIBLE(arr,type_num))) + sprintf(mess+strlen(mess)," -- input '%c' not compatible to '%c'", + arr->descr->type,descr->type); + PyErr_SetString(PyExc_ValueError,mess); + return NULL; + } + + /* here we have always intent(in) or intent(inplace) */ + + { + PyArrayObject *retarr = (PyArrayObject *) \ + PyArray_New(&PyArray_Type, arr->nd, arr->dimensions, type_num, + NULL,NULL,0, + !(intent&F2PY_INTENT_C), + NULL); + if (retarr==NULL) + return NULL; + F2PY_REPORT_ON_ARRAY_COPY_FROMARR; + if (PyArray_CopyInto(retarr, arr)) { + Py_DECREF(retarr); + return NULL; + } + if (intent & F2PY_INTENT_INPLACE) { + if (swap_arrays(arr,retarr)) + return NULL; /* XXX: set exception */ + Py_XDECREF(retarr); + if (intent & F2PY_INTENT_OUT) + Py_INCREF(arr); + } else { + arr = retarr; + } + } + return arr; + } + + if ((intent & F2PY_INTENT_INOUT) + || (intent & F2PY_INTENT_INPLACE) + || (intent & F2PY_INTENT_CACHE)) { + sprintf(mess,"failed to initialize intent(inout|inplace|cache) array" + " -- input must be array but got %s", + PyString_AsString(PyObject_Str(PyObject_Type(obj))) + ); + PyErr_SetString(PyExc_TypeError,mess); + return NULL; + } + + { + F2PY_REPORT_ON_ARRAY_COPY_FROMANY; + arr = (PyArrayObject *) \ + PyArray_FromAny(obj,PyArray_DescrFromType(type_num), 0,0, + ((intent & F2PY_INTENT_C)?CARRAY_FLAGS:FARRAY_FLAGS) \ + | FORCECAST ); + if (arr==NULL) + return NULL; + if (check_and_fix_dimensions(arr,rank,dims)) + return NULL; /*XXX: set exception */ + return arr; + } + +} + + /*****************************************/ + /* Helper functions for array_from_pyobj */ + /*****************************************/ + +static +int check_and_fix_dimensions(const PyArrayObject* arr,const int rank,intp *dims) { + /* + This function fills in blanks (that are -1\'s) in dims list using + the dimensions from arr. It also checks that non-blank dims will + match with the corresponding values in arr dimensions. + */ + const intp arr_size = (arr->nd)?PyArray_Size((PyObject *)arr):1; + + if (rank > arr->nd) { /* [1,2] -> [[1],[2]]; 1 -> [[1]] */ + intp new_size = 1; + int free_axe = -1; + int i; + /* Fill dims where -1 or 0; check dimensions; calc new_size; */ + for(i=0;i<arr->nd;++i) { + if (dims[i] >= 0) { + if (dims[i]!=arr->dimensions[i]) { + fprintf(stderr,"%d-th dimension must be fixed to %" INTP_FMT + " but got %" INTP_FMT "\n", + i,dims[i], arr->dimensions[i]); + return 1; + } + if (!dims[i]) dims[i] = 1; + } else { + dims[i] = arr->dimensions[i] ? arr->dimensions[i] : 1; + } + new_size *= dims[i]; + } + for(i=arr->nd;i<rank;++i) + if (dims[i]>1) { + fprintf(stderr,"%d-th dimension must be %" INTP_FMT + " but got 0 (not defined).\n", + i,dims[i]); + return 1; + } else if (free_axe<0) + free_axe = i; + else + dims[i] = 1; + if (free_axe>=0) { + dims[free_axe] = arr_size/new_size; + new_size *= dims[free_axe]; + } + if (new_size != arr_size) { + fprintf(stderr,"confused: new_size=%" INTP_FMT + ", arr_size=%" INTP_FMT " (maybe too many free" + " indices)\n", new_size,arr_size); + return 1; + } + } else { /* [[1,2]] -> [[1],[2]] */ + int i,j; + intp d; + int effrank; + intp size; + for (i=0,effrank=0;i<arr->nd;++i) + if (arr->dimensions[i]>1) ++effrank; + if (dims[rank-1]>=0) + if (effrank>rank) { + fprintf(stderr,"too many axes: %d (effrank=%d), expected rank=%d\n", + arr->nd,effrank,rank); + return 1; + } + for (i=0,j=0;i<rank;++i) { + while (j<arr->nd && arr->dimensions[j]<2) ++j; + if (j>=arr->nd) d = 1; + else d = arr->dimensions[j++]; + if (dims[i]>=0) { + if (d>1 && d!=dims[i]) { + fprintf(stderr,"%d-th dimension must be fixed to %" INTP_FMT + " but got %" INTP_FMT " (real index=%d)\n", + i,dims[i],d,j-1); + return 1; + } + if (!dims[i]) dims[i] = 1; + } else + dims[i] = d; + } + for (i=rank;i<arr->nd;++i) { /* [[1,2],[3,4]] -> [1,2,3,4] */ + while (j<arr->nd && arr->dimensions[j]<2) ++j; + if (j>=arr->nd) d = 1; + else d = arr->dimensions[j++]; + dims[rank-1] *= d; + } + for (i=0,size=1;i<rank;++i) size *= dims[i]; + if (size != arr_size) { + fprintf(stderr,"confused: size=%" INTP_FMT ", arr_size=%" INTP_FMT + ", rank=%d, effrank=%d, arr.nd=%d, dims=[", + size,arr_size,rank,effrank,arr->nd); + for (i=0;i<rank;++i) fprintf(stderr," %" INTP_FMT,dims[i]); + fprintf(stderr," ], arr.dims=["); + for (i=0;i<arr->nd;++i) fprintf(stderr," %" INTP_FMT,arr->dimensions[i]); + fprintf(stderr," ]\n"); + return 1; + } + } + return 0; +} + +/* End of file: array_from_pyobj.c */ + +/************************* copy_ND_array *******************************/ + +extern +int copy_ND_array(const PyArrayObject *arr, PyArrayObject *out) +{ + F2PY_REPORT_ON_ARRAY_COPY_FROMARR; + return PyArray_CopyInto(out, (PyArrayObject *)arr); +} + +#ifdef __cplusplus +} +#endif +/************************* EOF fortranobject.c *******************************/ diff --git a/numpy/f2py/src/fortranobject.h b/numpy/f2py/src/fortranobject.h new file mode 100644 index 000000000..680e6690e --- /dev/null +++ b/numpy/f2py/src/fortranobject.h @@ -0,0 +1,123 @@ +#ifndef Py_FORTRANOBJECT_H +#define Py_FORTRANOBJECT_H +#ifdef __cplusplus +extern "C" { +#endif + +#include "Python.h" + +#ifdef FORTRANOBJECT_C +#define NO_IMPORT_ARRAY +#endif +#define PY_ARRAY_UNIQUE_SYMBOL PyArray_API +#include "scipy/arrayobject.h" + + /* +#ifdef F2PY_REPORT_ATEXIT_DISABLE +#undef F2PY_REPORT_ATEXIT +#else + +#ifndef __FreeBSD__ +#ifndef __WIN32__ +#ifndef __APPLE__ +#define F2PY_REPORT_ATEXIT +#endif +#endif +#endif + +#endif + */ + +#ifdef F2PY_REPORT_ATEXIT +#include <sys/timeb.h> + extern void f2py_start_clock(void); + extern void f2py_stop_clock(void); + extern void f2py_start_call_clock(void); + extern void f2py_stop_call_clock(void); + extern void f2py_cb_start_clock(void); + extern void f2py_cb_stop_clock(void); + extern void f2py_cb_start_call_clock(void); + extern void f2py_cb_stop_call_clock(void); + extern void f2py_report_on_exit(int,void*); +#endif + +#ifdef DMALLOC +#include "dmalloc.h" +#endif + +/* Fortran object interface */ + +/* +123456789-123456789-123456789-123456789-123456789-123456789-123456789-12 + +PyFortranObject represents various Fortran objects: +Fortran (module) routines, COMMON blocks, module data. + +Author: Pearu Peterson <pearu@cens.ioc.ee> +*/ + +#define F2PY_MAX_DIMS 40 + +typedef void (*f2py_set_data_func)(char*,intp*); +typedef void (*f2py_void_func)(void); +typedef void (*f2py_init_func)(int*,intp*,f2py_set_data_func,int*); + + /*typedef void* (*f2py_c_func)(void*,...);*/ + +typedef void *(*f2pycfunc)(void); + +typedef struct { + char *name; /* attribute (array||routine) name */ + int rank; /* array rank, 0 for scalar, max is F2PY_MAX_DIMS, + || rank=-1 for Fortran routine */ + struct {intp d[F2PY_MAX_DIMS];} dims; /* dimensions of the array, || not used */ + int type; /* PyArray_<type> || not used */ + char *data; /* pointer to array || Fortran routine */ + f2py_init_func func; /* initialization function for + allocatable arrays: + func(&rank,dims,set_ptr_func,name,len(name)) + || C/API wrapper for Fortran routine */ + char *doc; /* documentation string; only recommended + for routines. */ +} FortranDataDef; + +typedef struct { + PyObject_HEAD + int len; /* Number of attributes */ + FortranDataDef *defs; /* An array of FortranDataDef's */ + PyObject *dict; /* Fortran object attribute dictionary */ +} PyFortranObject; + +#define PyFortran_Check(op) ((op)->ob_type == &PyFortran_Type) +#define PyFortran_Check1(op) (0==strcmp((op)->ob_type->tp_name,"fortran")) + + extern PyTypeObject PyFortran_Type; + extern PyObject * PyFortranObject_New(FortranDataDef* defs, f2py_void_func init); + extern PyObject * PyFortranObject_NewAsAttr(FortranDataDef* defs); + +#define ISCONTIGUOUS(m) ((m)->flags & CONTIGUOUS) +#define F2PY_INTENT_IN 1 +#define F2PY_INTENT_INOUT 2 +#define F2PY_INTENT_OUT 4 +#define F2PY_INTENT_HIDE 8 +#define F2PY_INTENT_CACHE 16 +#define F2PY_INTENT_COPY 32 +#define F2PY_INTENT_C 64 +#define F2PY_OPTIONAL 128 +#define F2PY_INTENT_INPLACE 256 + + extern PyArrayObject* array_from_pyobj(const int type_num, + intp *dims, + const int rank, + const int intent, + PyObject *obj); + extern int copy_ND_array(const PyArrayObject *in, PyArrayObject *out); + +#ifdef DEBUG_COPY_ND_ARRAY + extern void dump_attrs(const PyArrayObject* arr); +#endif + +#ifdef __cplusplus +} +#endif +#endif /* !Py_FORTRANOBJECT_H */ diff --git a/numpy/f2py/src/test/Makefile b/numpy/f2py/src/test/Makefile new file mode 100644 index 000000000..0f8869f72 --- /dev/null +++ b/numpy/f2py/src/test/Makefile @@ -0,0 +1,96 @@ +# -*- makefile -*- +# File: Makefile-foo +# Usage: +# make -f Makefile-foo [MODE=opt|debug] +# Notes: +# 1) You must use GNU make; try `gmake ..' if `make' fails. +# 2) This file is auto-generated with f2py (version 2.264). +# f2py is a Fortran to Python Interface Generator (FPIG), Second Edition, +# written by Pearu Peterson <pearu@ioc.ee>. +# See http://cens.ioc.ee/projects/f2py2e/ +# Generation date: Wed Sep 13 16:22:55 2000 +# $Revision: 1.2 $ +# $Date: 2000/09/17 16:10:27 $ + +# Recommendation notes produced by f2py2e/buildmakefile.py: +# *** + +PYINC = -I/numeric/include/python1.5/Numeric -I/numeric/include/python1.5 +INCLUDES = -I.. +LIBS = -L$(shell gcc -v 2>&1 | grep specs | sed -e 's/Reading specs from //g' | sed -e 's/\/specs//g') -lg2c +LIBS=-L$$ABSOFT/lib -lfio -lf77math -lf90math +LIBS=-L/numeric/bin -lvast90 -L/usr/lib/gcc-lib/i586-mandrake-linux/2.95.2 -lg2c + +# Wrapper generator: +F2PY = /home/pearu/bin/f2py-cvs + +# Fortran compiler: Absoft f95 +FC = f95 +FC = f90 +FOPT = +FDEBUG = +FFLAGS = -B108 -YCFRL=1 -YCOM_NAMES=LCS -YCOM_PFX -YCOM_SFX=_ -YEXT_PFX -YEXT_NAMES=LCS +FFLAGS = +# C compiler: cc ('gcc 2.x.x' 2.95.2) +CC = cc +COPT = +CDEBUG = +CFLAGS = -fpic + +# Linker: ld ('GNU ld' 2.9.5) +LD = ld +LDFLAGS = -shared -s +SO = .so + +ifeq '$(MODE)' 'debug' +FFLAGS += $(FDEBUG) +CFLAGS += $(CDEBUG) +endif +ifeq '$(MODE)' 'opt' +FFLAGS += $(FOPT) +CFLAGS += $(COPT) +endif +FFLAGS += $(INCLUDES) +CFLAGS += $(PYINC) $(INCLUDES) + +SRCC = ../fortranobject.c +SRCF = mod.f90 bar.f foo90.f90 wrap.f +SRCS = $(SRCC) $(SRCF) +OBJC = $(filter %.o,$(SRCC:.c=.o) $(SRCC:.cc=.o) $(SRCC:.C=.o)) +OBJF = $(filter %.o,$(SRCF:.f90=.o) $(SRCF:.f=.o) $(SRCF:.F=.o) $(SRCF:.for=.o)) +OBJS = $(OBJC) $(OBJF) + +INSTALLNAME = f2py2e-apps +INSTALLDIRECTORY = /numeric/lib/python1.5/site-packages/$(INSTALLNAME) +INSTALLDIR = install -d -c +INSTALLEXEC = install -m 755 -c + +all: foo + +foo: foomodule$(SO) +foomodule$(SO) : foomodule.o $(OBJS) + $(LD) $(LDFLAGS) -o $@ $< $(OBJS) $(LIBS) + +foomodule.o: foomodule.c + + +$(OBJS) : $(SRCS) +%.o : %.f ; $(FC) -c $(FFLAGS) $< +%.o : %.f90 ; $(FC) -c $(FFLAGS) $< + +test: foomodule$(SO) + python -c 'import foo;print foo.__doc__' +install: foomodule$(SO) + $(INSTALLDIR) $(INSTALLDIRECTORY) + $(INSTALLEXEC) foomodule$(SO) $(INSTALLDIRECTORY) + cd $(INSTALLDIRECTORY) && echo "$(INSTALLNAME)" > ../$(INSTALLNAME).pth + +.PHONY: clean distclean debug test install foo +debug: + echo "OBJS=$(OBJS)" + echo "SRCS=$(SRCS)" +clean: + $(RM) *.o *.mod core foomodule.{dvi,log} $(OBJS) +distclean: clean + $(RM) *.so *.sl foomodule.{tex,so} + $(RM) .f2py_get_compiler_* diff --git a/numpy/f2py/src/test/bar.f b/numpy/f2py/src/test/bar.f new file mode 100644 index 000000000..5354ceaf9 --- /dev/null +++ b/numpy/f2py/src/test/bar.f @@ -0,0 +1,11 @@ + subroutine bar() + integer a + real*8 b,c(3) + common /foodata/ a,b,c + a = 4 + b = 6.7 + c(2) = 3.0 + write(*,*) "bar:a=",a + write(*,*) "bar:b=",b + write(*,*) "bar:c=",c + end diff --git a/numpy/f2py/src/test/foo.f b/numpy/f2py/src/test/foo.f new file mode 100644 index 000000000..5354ceaf9 --- /dev/null +++ b/numpy/f2py/src/test/foo.f @@ -0,0 +1,11 @@ + subroutine bar() + integer a + real*8 b,c(3) + common /foodata/ a,b,c + a = 4 + b = 6.7 + c(2) = 3.0 + write(*,*) "bar:a=",a + write(*,*) "bar:b=",b + write(*,*) "bar:c=",c + end diff --git a/numpy/f2py/src/test/foo90.f90 b/numpy/f2py/src/test/foo90.f90 new file mode 100644 index 000000000..dbca7e95b --- /dev/null +++ b/numpy/f2py/src/test/foo90.f90 @@ -0,0 +1,13 @@ +subroutine foo() + integer a + real*8 b,c(3) + common /foodata/ a,b,c + print*, " F: in foo" + a = 5 + b = 6.3 + c(2) = 9.1 +end subroutine foo + + + + diff --git a/numpy/f2py/src/test/foomodule.c b/numpy/f2py/src/test/foomodule.c new file mode 100644 index 000000000..0a954676e --- /dev/null +++ b/numpy/f2py/src/test/foomodule.c @@ -0,0 +1,143 @@ +/* File: foomodule.c + * Example of FortranObject usage. See also wrap.f foo.f foo90.f90. + * Author: Pearu Peterson <pearu@ioc.ee>. + * http://cens.ioc.ee/projects/f2py2e/ + * $Revision: 1.2 $ + * $Date: 2000/09/17 16:10:27 $ + */ +#ifdef __CPLUSPLUS__ +extern "C" { +#endif + +#include "Python.h" +#include "fortranobject.h" + +static PyObject *foo_error; + +#if defined(NO_APPEND_FORTRAN) +#if defined(UPPERCASE_FORTRAN) +#define F_FUNC(f,F) F +#else +#define F_FUNC(f,F) f +#endif +#else +#if defined(UPPERCASE_FORTRAN) +#define F_FUNC(f,F) F##_ +#else +#define F_FUNC(f,F) f##_ +#endif +#endif + + /************* foo_bar *************/ + static char doc_foo_bar[] = "\ +Function signature:\n\ + bar()\n\ +"; + static PyObject *foo_bar(PyObject *capi_self, PyObject *capi_args, + PyObject *capi_keywds, void (*f2py_func)()) { + PyObject *capi_buildvalue = NULL; + static char *capi_kwlist[] = {NULL}; + if (!PyArg_ParseTupleAndKeywords(capi_args,capi_keywds,\ + "|:foo.bar",\ + capi_kwlist)) + goto capi_fail; + (*f2py_func)(); + capi_buildvalue = Py_BuildValue(""); + capi_fail: + return capi_buildvalue; + } + /************ mod_init **************/ + static PyObject *mod_init(PyObject *capi_self, PyObject *capi_args, + PyObject *capi_keywds, void (*f2py_func)()) { + PyObject *capi_buildvalue = NULL; + static char *capi_kwlist[] = {NULL}; + if (!PyArg_ParseTupleAndKeywords(capi_args,capi_keywds,\ + "|:mod.init",\ + capi_kwlist)) + goto capi_fail; + (*f2py_func)(); + capi_buildvalue = Py_BuildValue(""); + capi_fail: + return capi_buildvalue; + } + + /* F90 module */ + static FortranDataDef f2py_mod_def[] = { + {"a",0, {}, PyArray_INT}, + {"b",0, {}, PyArray_DOUBLE}, + {"c",1, {3}, PyArray_DOUBLE}, + {"d",1, {-1}, PyArray_DOUBLE}, + {"init",-1,{},0,NULL,(void *)mod_init}, + {NULL} + }; + static void f2py_setup_mod(char *a,char *b,char *c,void (*d)(),char *init) { + f2py_mod_def[0].data = a; + f2py_mod_def[1].data = b; + f2py_mod_def[2].data = c; + f2py_mod_def[3].func = d; + f2py_mod_def[4].data = init; + } + extern void F_FUNC(f2pyinitmod,F2PYINITMOD)(); + static void f2py_init_mod() { + F_FUNC(f2pyinitmod,F2PYINITMOD)(f2py_setup_mod); + } + + /* COMMON block */ + static FortranDataDef f2py_foodata_def[] = { + {"a",0, {}, PyArray_INT}, + {"b",0, {}, PyArray_DOUBLE}, + {"c",1, {3}, PyArray_DOUBLE}, + {NULL} + }; + static void f2py_setup_foodata(char *a,char *b,char *c) { + f2py_foodata_def[0].data = a; + f2py_foodata_def[1].data = b; + f2py_foodata_def[2].data = c; + } + extern void F_FUNC(f2pyinitfoodata,F2PYINITFOODATA)(); + static void f2py_init_foodata() { + F_FUNC(f2pyinitfoodata,F2PYINITFOODATA)(f2py_setup_foodata); + } + + /* Fortran routines (needs no initialization/setup function) */ + extern void F_FUNC(bar,BAR)(); + extern void F_FUNC(foo,FOO)(); + static FortranDataDef f2py_routines_def[] = { + {"bar",-1, {}, 0, (char *)F_FUNC(bar,BAR),(void *)foo_bar,doc_foo_bar}, + {"foo",-1, {}, 0, (char *)F_FUNC(foo,FOO),(void *)foo_bar,doc_foo_bar}, + {NULL} + }; + +static PyMethodDef foo_module_methods[] = { +/*eof method*/ + {NULL,NULL} +}; + +void initfoo() { + int i; + PyObject *m, *d, *s; + PyTypeObject *t; + PyObject *f; + import_array(); + + m = Py_InitModule("foo", foo_module_methods); + + d = PyModule_GetDict(m); + s = PyString_FromString("This module 'foo' demonstrates the usage of fortranobject."); + PyDict_SetItemString(d, "__doc__", s); + + /* Fortran objects: */ + PyDict_SetItemString(d, "mod", PyFortranObject_New(f2py_mod_def,f2py_init_mod)); + PyDict_SetItemString(d, "foodata", PyFortranObject_New(f2py_foodata_def,f2py_init_foodata)); + for(i=0;f2py_routines_def[i].name!=NULL;i++) + PyDict_SetItemString(d, f2py_routines_def[i].name, + PyFortranObject_NewAsAttr(&f2py_routines_def[i])); + + Py_DECREF(s); + + if (PyErr_Occurred()) + Py_FatalError("can't initialize module foo"); +} +#ifdef __CPLUSCPLUS__ +} +#endif diff --git a/numpy/f2py/src/test/wrap.f b/numpy/f2py/src/test/wrap.f new file mode 100644 index 000000000..9414eb9f6 --- /dev/null +++ b/numpy/f2py/src/test/wrap.f @@ -0,0 +1,70 @@ + subroutine f2py_mod_get_dims(f2py_r,f2py_s,f2py_set,f2py_n) + use mod + external f2py_set + logical f2py_ns + integer f2py_s(*),f2py_r,f2py_i,f2py_j + character*(*) f2py_n + if ("d".eq.f2py_n) then + f2py_ns = .FALSE. + if (allocated(d)) then + do f2py_i=1,f2py_r + if ((size(d,f2py_r-f2py_i+1).ne.f2py_s(f2py_i)).and. + c (f2py_s(f2py_i).ge.0)) then + f2py_ns = .TRUE. + end if + end do + if (f2py_ns) then + deallocate(d) + end if + end if + if (.not.allocated(d)) then + allocate(d(f2py_s(1))) + end if + if (allocated(d)) then + do f2py_i=1,f2py_r + f2py_s(f2py_i) = size(d,f2py_r-f2py_i+1) + end do + call f2py_set(d) + end if + end if + end subroutine f2py_mod_get_dims + subroutine f2py_mod_get_dims_d(r,s,set_data) + use mod, only: d => d + external set_data + logical ns + integer s(*),r,i,j + ns = .FALSE. + if (allocated(d)) then + do i=1,r + if ((size(d,r-i+1).ne.s(i)).and.(s(i).ge.0)) then + ns = .TRUE. + end if + end do + if (ns) then + deallocate(d) + end if + end if + if (.not.allocated(d).and.(s(1).ge.1)) then + allocate(d(s(1))) + end if + if (allocated(d)) then + do i=1,r + s(i) = size(d,r-i+1) + end do + end if + call set_data(d,allocated(d)) + end subroutine f2py_mod_get_dims_d + + subroutine f2pyinitmod(setupfunc) + use mod + external setupfunc,f2py_mod_get_dims_d,init + call setupfunc(a,b,c,f2py_mod_get_dims_d,init) + end subroutine f2pyinitmod + + subroutine f2pyinitfoodata(setupfunc) + external setupfunc + integer a + real*8 b,c(3) + common /foodata/ a,b,c + call setupfunc(a,b,c) + end subroutine f2pyinitfoodata |