OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/32627 ([ISO Bind C] Accept c_f_pointer for TYPE)

Browse Source 
2007-07-21  Christopher D. Rickett  <crickett@lanl.gov>

        PR fortran/32627
        * resolve.c (set_name_and_label): Set kind number for character
        version of c_f_pointer.
        (gfc_iso_c_sub_interface): Set the kind of the SHAPE formal arg to
        that of the actual SHAPE arg.
        * symbol.c (gen_shape_param): Initialize kind for SHAPE arg.

2007-07-21  Christopher D. Rickett  <crickett@lanl.gov>

        PR fortran/32627
        * libgfortran/intrinsics/iso_c_generated_procs.c: Add c_f_pointer
        for character/string arguments.
        * libgfortran/intrinsic/iso_c_binding.c (c_f_pointer_u0): Allow
        the optional SHAPE arg to be any valid integer kind.
        * libgfortran/gfortran.map: Add c_f_pointer_s0.
        * libgfortran/mk-kinds-h.sh: Save smallest integer kind as default
        character kind.
        * libgfortran/intrinsics/iso_c_generated_procs.c: Add versions of
        c_f_pointer for complex and logical types.
        * libgfortran/gfortran.map: Add c_f_pointer versions for logical
        and complex types.

2007-07-21  Christopher D. Rickett  <crickett@lanl.gov>

        PR fortran/32627
        * gfortran.dg/pr32627_driver.c: Driver for pr32627.
        * gfortran.dg/pr32627.f03: New test case.
        * gfortran.dg/c_f_pointer_logical.f03: New test case.
        * gfortran.dg/c_f_pointer_logical_driver.c: Driver for
        c_f_pointer_logical.
        * gfortran.dg/c_f_pointer_complex_driver.c: Driver for
        c_f_pointer_complex.
        * gfortran.dg/c_f_pointer_complex.f03: New test case.
        * gfortran.dg/c_f_pointer_shape_tests_2_driver.c: Driver for
        c_f_pointer_shape_tests_2.
        * gfortran.dg/c_f_pointer_shape_tests_2.f03: New test case.

From-SVN: r126817
This commit is contained in:
Christopher D. Rickett 2007-07-21 23:45:44 +00:00 committed by Steven G. Kargl
parent 8e4c6d8802
commit 6ad5cf725f
17 changed files with 630 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32627
* resolve.c (set_name_and_label): Set kind number for character
version of c_f_pointer.
(gfc_iso_c_sub_interface): Set the kind of the SHAPE formal arg to
that of the actual SHAPE arg.
* symbol.c (gen_shape_param): Initialize kind for SHAPE arg.
2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32801

12
gcc/fortran/resolve.c
View File

@ -2282,6 +2282,11 @@ set_name_and_label (gfc_code *c, gfc_symbol *sym,
type = gfc_type_letter (arg->ts.type);
kind = arg->ts.kind;
}
if (arg->ts.type == BT_CHARACTER)
/* Kind info for character strings not needed. */
kind = 0;
sprintf (name, "%s_%c%d", sym->name, type, kind);
/* Set up the binding label as the given symbol's label plus
the type and kind. */
@ -2356,6 +2361,13 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
/* the 1 means to add the optional arg to formal list */
new_sym = get_iso_c_sym (sym, name, binding_label, 1);
/* Set the kind for the SHAPE array to that of the actual
(if given). */
if (c->ext.actual != NULL && c->ext.actual->next != NULL
&& c->ext.actual->next->expr->rank != 0)
new_sym->formal->next->next->sym->ts.kind =
c->ext.actual->next->next->expr->ts.kind;
/* for error reporting, say it's declared where the original was */
new_sym->declared_at = sym->declared_at;
}

3
gcc/fortran/symbol.c
View File

@ -3421,6 +3421,9 @@ gen_shape_param (gfc_formal_arglist **head,
/* Integer array, rank 1, describing the shape of the object. */
param_sym->ts.type = BT_INTEGER;
/* Initialize the kind to default integer. However, it will be overriden
during resolution to match the kind of the SHAPE parameter given as
the actual argument (to allow for any valid integer kind). */
param_sym->ts.kind = gfc_default_integer_kind;
param_sym->as = gfc_get_array_spec ();

18
gcc/testsuite/ChangeLog
View File

@ -1,4 +1,20 @@
2007-07-19 Christopher D. Rickett <crickett@lanl.gov>
2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32627
* gfortran.dg/pr32627_driver.c: Driver for pr32627.
* gfortran.dg/pr32627.f03: New test case.
* gfortran.dg/c_f_pointer_logical.f03: New test case.
* gfortran.dg/c_f_pointer_logical_driver.c: Driver for
c_f_pointer_logical.
* gfortran.dg/c_f_pointer_complex_driver.c: Driver for
c_f_pointer_complex.
* gfortran.dg/c_f_pointer_complex.f03: New test case.
* gfortran.dg/c_f_pointer_shape_tests_2_driver.c: Driver for
c_f_pointer_shape_tests_2.
* gfortran.dg/c_f_pointer_shape_tests_2.f03: New test case.
2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32804
* gfortran.dg/c_loc_tests_9.f03: New test case.

61
gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 Normal file
View File

@ -0,0 +1,61 @@
! { dg-do run }
! { dg-additional-sources c_f_pointer_complex_driver.c }
! { dg-options "-std=gnu -w" }
! Test c_f_pointer for the different types of interoperable complex values.
module c_f_pointer_complex
use, intrinsic :: iso_c_binding, only: c_float_complex, c_double_complex, &
c_long_double_complex, c_f_pointer, c_ptr, c_long_double, c_int
implicit none
contains
subroutine test_complex_scalars(my_c_float_complex, my_c_double_complex, &
my_c_long_double_complex) bind(c)
type(c_ptr), value :: my_c_float_complex
type(c_ptr), value :: my_c_double_complex
type(c_ptr), value :: my_c_long_double_complex
complex(c_float_complex), pointer :: my_f03_float_complex
complex(c_double_complex), pointer :: my_f03_double_complex
complex(c_long_double_complex), pointer :: my_f03_long_double_complex
call c_f_pointer(my_c_float_complex, my_f03_float_complex)
call c_f_pointer(my_c_double_complex, my_f03_double_complex)
call c_f_pointer(my_c_long_double_complex, my_f03_long_double_complex)
if(my_f03_float_complex /= (1.0, 0.0)) call abort ()
if(my_f03_double_complex /= (2.0d0, 0.0d0)) call abort ()
if(my_f03_long_double_complex /= (3.0_c_long_double, &
0.0_c_long_double)) call abort ()
end subroutine test_complex_scalars
subroutine test_complex_arrays(float_complex_array, double_complex_array, &
long_double_complex_array, num_elems) bind(c)
type(c_ptr), value :: float_complex_array
type(c_ptr), value :: double_complex_array
type(c_ptr), value :: long_double_complex_array
complex(c_float_complex), pointer, dimension(:) :: f03_float_complex_array
complex(c_double_complex), pointer, dimension(:) :: &
f03_double_complex_array
complex(c_long_double_complex), pointer, dimension(:) :: &
f03_long_double_complex_array
integer(c_int), value :: num_elems
integer :: i
call c_f_pointer(float_complex_array, f03_float_complex_array, &
(/ num_elems /))
call c_f_pointer(double_complex_array, f03_double_complex_array, &
(/ num_elems /))
call c_f_pointer(long_double_complex_array, &
f03_long_double_complex_array, (/ num_elems /))
do i = 1, num_elems
if(f03_float_complex_array(i) &
/= (i*(1.0, 0.0))) call abort ()
if(f03_double_complex_array(i) &
/= (i*(1.0d0, 0.0d0))) call abort ()
if(f03_long_double_complex_array(i) &
/= (i*(1.0_c_long_double, 0.0_c_long_double))) call abort ()
end do
end subroutine test_complex_arrays
end module c_f_pointer_complex
! { dg-final { cleanup-modules "c_f_pointer_complex" } }

41
gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c Normal file
View File

@ -0,0 +1,41 @@
/* { dg-options "-std=c99 -w" } */
/* From c_by_val.c in gfortran.dg. */
#define _Complex_I (1.0iF)
#define NUM_ELEMS 10
void test_complex_scalars (float _Complex *float_complex_ptr,
double _Complex *double_complex_ptr,
long double _Complex *long_double_complex_ptr);
void test_complex_arrays (float _Complex *float_complex_array,
double _Complex *double_complex_array,
long double _Complex *long_double_complex_array,
int num_elems);
int main (int argc, char **argv)
{
float _Complex c1;
double _Complex c2;
long double _Complex c3;
float _Complex c1_array[NUM_ELEMS];
double _Complex c2_array[NUM_ELEMS];
long double _Complex c3_array[NUM_ELEMS];
int i;
c1 = 1.0 + 0.0 * _Complex_I;
c2 = 2.0 + 0.0 * _Complex_I;
c3 = 3.0 + 0.0 * _Complex_I;
test_complex_scalars (&c1, &c2, &c3);
for (i = 0; i < NUM_ELEMS; i++)
{
c1_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
c2_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
c3_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
}
test_complex_arrays (c1_array, c2_array, c3_array, NUM_ELEMS);
return 0;
}

34
gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03 Normal file
View File

@ -0,0 +1,34 @@
! { dg-do run }
! { dg-additional-sources c_f_pointer_logical_driver.c }
! Verify that c_f_pointer exists for C logicals (_Bool).
module c_f_pointer_logical
use, intrinsic :: iso_c_binding, only: c_bool, c_f_pointer, c_ptr, c_int
contains
subroutine test_scalar(c_logical_ptr) bind(c)
type(c_ptr), value :: c_logical_ptr
logical(c_bool), pointer :: f03_logical_ptr
call c_f_pointer(c_logical_ptr, f03_logical_ptr)
if(f03_logical_ptr .neqv. .true.) call abort ()
end subroutine test_scalar
subroutine test_array(c_logical_array, num_elems) bind(c)
type(c_ptr), value :: c_logical_array
integer(c_int), value :: num_elems
logical(c_bool), pointer, dimension(:) :: f03_logical_array
integer :: i
call c_f_pointer(c_logical_array, f03_logical_array, (/ num_elems /))
! Odd numbered locations are true (even numbered offsets in C)
do i = 1, num_elems, 2
if(f03_logical_array(i) .neqv. .true.) call abort ()
end do
! Even numbered locations are false.
do i = 2, num_elems, 2
if(f03_logical_array(i) .neqv. .false.) call abort ()
end do
end subroutine test_array
end module c_f_pointer_logical
! { dg-final { cleanup-modules "c_f_pointer_logical" } }

26
gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c Normal file
View File

@ -0,0 +1,26 @@
/* { dg-options "-std=c99 -w" } */
#include <stdbool.h>
#define NUM_ELEMS 10
void test_scalar(_Bool *my_c_bool_ptr);
void test_array(_Bool *my_bool_array, int num_elems);
int main(int argc, char **argv)
{
_Bool my_bool = true;
_Bool my_bool_array[NUM_ELEMS];
int i;
test_scalar(&my_bool);
for(i = 0; i < NUM_ELEMS; i+=2)
my_bool_array[i] = true;
for(i = 1; i < NUM_ELEMS; i+=2)
my_bool_array[i] = false;
test_array(my_bool_array, NUM_ELEMS);
return 0;
}

91
gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2.f03 Normal file
View File

@ -0,0 +1,91 @@
! { dg-do run }
! { dg-additional-sources c_f_pointer_shape_tests_2_driver.c }
! Verify that the optional SHAPE parameter to c_f_pointer can be of any
! valid integer kind. We don't test all kinds here since it would be
! difficult to know what kinds are valid for the architecture we're running on.
! However, testing ones that should be different should be sufficient.
module c_f_pointer_shape_tests_2
use, intrinsic :: iso_c_binding
implicit none
contains
subroutine test_long_long_1d(cPtr, num_elems) bind(c)
use, intrinsic :: iso_c_binding
type(c_ptr), value :: cPtr
integer(c_int), value :: num_elems
integer, dimension(:), pointer :: myArrayPtr
integer(c_long_long), dimension(1) :: shape
integer :: i
shape(1) = num_elems
call c_f_pointer(cPtr, myArrayPtr, shape)
do i = 1, num_elems
if(myArrayPtr(i) /= (i-1)) call abort ()
end do
end subroutine test_long_long_1d
subroutine test_long_long_2d(cPtr, num_rows, num_cols) bind(c)
use, intrinsic :: iso_c_binding
type(c_ptr), value :: cPtr
integer(c_int), value :: num_rows
integer(c_int), value :: num_cols
integer, dimension(:,:), pointer :: myArrayPtr
integer(c_long_long), dimension(2) :: shape
integer :: i,j
shape(1) = num_rows
shape(2) = num_cols
call c_f_pointer(cPtr, myArrayPtr, shape)
do j = 1, num_cols
do i = 1, num_rows
if(myArrayPtr(i,j) /= ((j-1)*num_rows)+(i-1)) call abort ()
end do
end do
end subroutine test_long_long_2d
subroutine test_long_1d(cPtr, num_elems) bind(c)
use, intrinsic :: iso_c_binding
type(c_ptr), value :: cPtr
integer(c_int), value :: num_elems
integer, dimension(:), pointer :: myArrayPtr
integer(c_long), dimension(1) :: shape
integer :: i
shape(1) = num_elems
call c_f_pointer(cPtr, myArrayPtr, shape)
do i = 1, num_elems
if(myArrayPtr(i) /= (i-1)) call abort ()
end do
end subroutine test_long_1d
subroutine test_int_1d(cPtr, num_elems) bind(c)
use, intrinsic :: iso_c_binding
type(c_ptr), value :: cPtr
integer(c_int), value :: num_elems
integer, dimension(:), pointer :: myArrayPtr
integer(c_int), dimension(1) :: shape
integer :: i
shape(1) = num_elems
call c_f_pointer(cPtr, myArrayPtr, shape)
do i = 1, num_elems
if(myArrayPtr(i) /= (i-1)) call abort ()
end do
end subroutine test_int_1d
subroutine test_short_1d(cPtr, num_elems) bind(c)
use, intrinsic :: iso_c_binding
type(c_ptr), value :: cPtr
integer(c_int), value :: num_elems
integer, dimension(:), pointer :: myArrayPtr
integer(c_short), dimension(1) :: shape
integer :: i
shape(1) = num_elems
call c_f_pointer(cPtr, myArrayPtr, shape)
do i = 1, num_elems
if(myArrayPtr(i) /= (i-1)) call abort ()
end do
end subroutine test_short_1d
end module c_f_pointer_shape_tests_2
! { dg-final { cleanup-modules "c_f_pointer_shape_tests_2" } }

41
gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2_driver.c Normal file
View File

@ -0,0 +1,41 @@
#define NUM_ELEMS 10
#define NUM_ROWS 2
#define NUM_COLS 3
void test_long_long_1d(int *array, int num_elems);
void test_long_long_2d(int *array, int num_rows, int num_cols);
void test_long_1d(int *array, int num_elems);
void test_int_1d(int *array, int num_elems);
void test_short_1d(int *array, int num_elems);
int main(int argc, char **argv)
{
int my_array[NUM_ELEMS];
int my_2d_array[NUM_ROWS][NUM_COLS];
int i, j;
for(i = 0; i < NUM_ELEMS; i++)
my_array[i] = i;
for(i = 0; i < NUM_ROWS; i++)
for(j = 0; j < NUM_COLS; j++)
my_2d_array[i][j] = (i*NUM_COLS) + j;
/* Test c_f_pointer where SHAPE is of type integer, kind=c_long_long. */
test_long_long_1d(my_array, NUM_ELEMS);
/* Test c_f_pointer where SHAPE is of type integer, kind=c_long_long.
The indices are transposed for Fortran. */
test_long_long_2d(my_2d_array[0], NUM_COLS, NUM_ROWS);
/* Test c_f_pointer where SHAPE is of type integer, kind=c_long. */
test_long_1d(my_array, NUM_ELEMS);
/* Test c_f_pointer where SHAPE is of type integer, kind=c_int. */
test_int_1d(my_array, NUM_ELEMS);
/* Test c_f_pointer where SHAPE is of type integer, kind=c_short. */
test_short_1d(my_array, NUM_ELEMS);
return 0;
}

32
gcc/testsuite/gfortran.dg/pr32627.f03 Normal file
View File

@ -0,0 +1,32 @@
! { dg-do run }
! { dg-additional-sources pr32627_driver.c }
! Verify that c_f_pointer exists for string arguments.
program main
use iso_c_binding
implicit none
interface
function get_c_string() bind(c)
use, intrinsic :: iso_c_binding, only: c_ptr
type(c_ptr) :: get_c_string
end function get_c_string
end interface
type, bind( c ) :: A
integer( c_int ) :: xc, yc
type( c_ptr ) :: str
end type
type( c_ptr ) :: x
type( A ), pointer :: fptr
type( A ), target :: my_a_type
character( len=9 ), pointer :: strptr
fptr => my_a_type
fptr%str = get_c_string()
call c_f_pointer( fptr%str, strptr )
print *, 'strptr is: ', strptr
end program main

4
gcc/testsuite/gfortran.dg/pr32627_driver.c Normal file
View File

@ -0,0 +1,4 @@
char *get_c_string()
{
return "c_string";
}

15
libgfortran/ChangeLog
View File

@ -1,3 +1,18 @@
2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32627
* libgfortran/intrinsics/iso_c_generated_procs.c: Add c_f_pointer
for character/string arguments.
* libgfortran/intrinsic/iso_c_binding.c (c_f_pointer_u0): Allow
the optional SHAPE arg to be any valid integer kind.
* libgfortran/gfortran.map: Add c_f_pointer_s0.
* libgfortran/mk-kinds-h.sh: Save smallest integer kind as default
character kind.
* libgfortran/intrinsics/iso_c_generated_procs.c: Add versions of
c_f_pointer for complex and logical types.
* libgfortran/gfortran.map: Add c_f_pointer versions for logical
and complex types.
2007-07-19 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32600

9
libgfortran/gfortran.map
View File

@ -1016,6 +1016,15 @@ GFORTRAN_1.0 {
__iso_c_binding_c_f_pointer_r8;
__iso_c_binding_c_f_pointer_r10;
__iso_c_binding_c_f_pointer_r16;
__iso_c_binding_c_f_pointer_c4;
__iso_c_binding_c_f_pointer_c8;
__iso_c_binding_c_f_pointer_c10;
__iso_c_binding_c_f_pointer_c16;
__iso_c_binding_c_f_pointer_s0;
__iso_c_binding_c_f_pointer_l1;
__iso_c_binding_c_f_pointer_l2;
__iso_c_binding_c_f_pointer_l4;
__iso_c_binding_c_f_pointer_l8;
__iso_c_binding_c_f_pointer_u0;
__iso_c_binding_c_f_procpointer;
__iso_c_binding_c_funloc;

23
libgfortran/intrinsics/iso_c_binding.c
View File

@ -109,7 +109,28 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in,
{
/* Lower bound is 1, as specified by the draft. */
f_ptr_out->dim[i].lbound = 1;
f_ptr_out->dim[i].ubound = ((int *) (shape->data))[i];
/* Have to allow for the SHAPE array to be any valid kind for
an INTEGER type. */
#ifdef HAVE_GFC_INTEGER_1
if (GFC_DESCRIPTOR_SIZE (shape) == 1)
f_ptr_out->dim[i].ubound = ((GFC_INTEGER_1 *) (shape->data))[i];
#endif
#ifdef HAVE_GFC_INTEGER_2
if (GFC_DESCRIPTOR_SIZE (shape) == 2)
f_ptr_out->dim[i].ubound = ((GFC_INTEGER_2 *) (shape->data))[i];
#endif
#ifdef HAVE_GFC_INTEGER_4
if (GFC_DESCRIPTOR_SIZE (shape) == 4)
f_ptr_out->dim[i].ubound = ((GFC_INTEGER_4 *) (shape->data))[i];
#endif
#ifdef HAVE_GFC_INTEGER_8
if (GFC_DESCRIPTOR_SIZE (shape) == 8)
f_ptr_out->dim[i].ubound = ((GFC_INTEGER_8 *) (shape->data))[i];
#endif
#ifdef HAVE_GFC_INTEGER_16
if (GFC_DESCRIPTOR_SIZE (shape) == 16)
f_ptr_out->dim[i].ubound = ((GFC_INTEGER_16 *) (shape->data))[i];
#endif
}
/* Set the offset and strides.

207
libgfortran/intrinsics/iso_c_generated_procs.c
View File

@ -75,11 +75,57 @@ void ISO_C_BINDING_PREFIX (c_f_pointer_r8) (void *, gfc_array_void *,
void ISO_C_BINDING_PREFIX (c_f_pointer_r10) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_REAL_16
void ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_COMPLEX_4
void ISO_C_BINDING_PREFIX (c_f_pointer_c4) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_COMPLEX_8
void ISO_C_BINDING_PREFIX (c_f_pointer_c8) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_COMPLEX_10
void ISO_C_BINDING_PREFIX (c_f_pointer_c10) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_COMPLEX_16
void ISO_C_BINDING_PREFIX (c_f_pointer_c16) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef GFC_DEFAULT_CHAR
void ISO_C_BINDING_PREFIX (c_f_pointer_s0) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_LOGICAL_1
void ISO_C_BINDING_PREFIX (c_f_pointer_l1) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_LOGICAL_2
void ISO_C_BINDING_PREFIX (c_f_pointer_l2) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_LOGICAL_4
void ISO_C_BINDING_PREFIX (c_f_pointer_l4) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_LOGICAL_8
void ISO_C_BINDING_PREFIX (c_f_pointer_l8) (void *, gfc_array_void *,
const array_t *);
#endif
#ifdef HAVE_GFC_INTEGER_1
/* Set the given Fortran pointer, 'f_ptr_out', to point to the given C
@ -262,3 +308,164 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *c_ptr_in,
(int) sizeof (GFC_REAL_16));
}
#endif
#ifdef HAVE_GFC_COMPLEX_4
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type complex and
kind=4. The function c_f_pointer is used to set up the pointer
descriptor. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_c4) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have an complex(kind=4). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_COMPLEX,
(int) sizeof (GFC_COMPLEX_4));
}
#endif
#ifdef HAVE_GFC_COMPLEX_8
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type complex and
kind=8. The function c_f_pointer is used to set up the pointer
descriptor. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_c8) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have an complex(kind=8). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_COMPLEX,
(int) sizeof (GFC_COMPLEX_8));
}
#endif
#ifdef HAVE_GFC_COMPLEX_10
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type complex and
kind=10. The function c_f_pointer is used to set up the pointer
descriptor. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_c10) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have an complex(kind=10). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_COMPLEX,
(int) sizeof (GFC_COMPLEX_10));
}
#endif
#ifdef HAVE_GFC_COMPLEX_16
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type complex and
kind=16. The function c_f_pointer is used to set up the pointer
descriptor. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_c16) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have an complex(kind=16). */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_COMPLEX,
(int) sizeof (GFC_COMPLEX_16));
}
#endif
#ifdef GFC_DEFAULT_CHAR
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type character. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_s0) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have a character string of len=1. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_CHARACTER,
(int) sizeof (char));
}
#endif
#ifdef HAVE_GFC_LOGICAL_1
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type logical, kind=1. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_l1) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have a logical of kind=1. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_LOGICAL,
(int) sizeof (GFC_LOGICAL_1));
}
#endif
#ifdef HAVE_GFC_LOGICAL_2
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type logical, kind=2. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_l2) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have a logical of kind=2. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_LOGICAL,
(int) sizeof (GFC_LOGICAL_2));
}
#endif
#ifdef HAVE_GFC_LOGICAL_4
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type logical, kind=4. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_l4) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have a logical of kind=4. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_LOGICAL,
(int) sizeof (GFC_LOGICAL_4));
}
#endif
#ifdef HAVE_GFC_LOGICAL_8
/* Set the given Fortran pointer, f_ptr_out, to point to the given C
address, c_ptr_in. The Fortran pointer is of type logical, kind=8. */
void
ISO_C_BINDING_PREFIX (c_f_pointer_l8) (void *c_ptr_in,
gfc_array_void *f_ptr_out,
const array_t *shape)
{
/* Here we have a logical of kind=8. */
ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape,
(int) GFC_DTYPE_LOGICAL,
(int) sizeof (GFC_LOGICAL_8));
}
#endif

6
libgfortran/mk-kinds-h.sh
View File

@ -8,6 +8,7 @@ possible_real_kinds="4 8 10 16"
largest=""
smallest=""
for k in $possible_integer_kinds; do
echo " integer (kind=$k) :: i" > tmp$$.f90
echo " end" >> tmp$$.f90
@ -21,6 +22,10 @@ for k in $possible_integer_kinds; do
prefix=""
fi
if [ "$smallest" = "" ]; then
smallest="$k"
fi
echo "typedef ${prefix}int${s}_t GFC_INTEGER_${k};"
echo "typedef ${prefix}uint${s}_t GFC_UINTEGER_${k};"
echo "typedef GFC_INTEGER_${k} GFC_LOGICAL_${k};"
@ -32,6 +37,7 @@ done
echo "#define GFC_INTEGER_LARGEST GFC_INTEGER_${largest}"
echo "#define GFC_UINTEGER_LARGEST GFC_UINTEGER_${largest}"
echo "#define GFC_DEFAULT_CHAR ${smallest}"
echo ""