* ISO_Fortran_binding patch
@ 2019-01-07 20:29 Paul Richard Thomas
2019-01-08 23:19 ` Thomas Koenig
0 siblings, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2019-01-07 20:29 UTC (permalink / raw)
To: fortran, gcc-patches, Thomas Koenig, Steve Kargl
[-- Attachment #1: Type: text/plain, Size: 2316 bytes --]
This is an updated version of the earlier patch. The main addition is
a second testcase that checks the errors emitted by the CFI API
functions.
It should be noted that there is some strangeness in the test for
CFI_select_part errors. The order of the tests matters. If they are
inverted from the order in the patch, the test fails for -O2 and
greater. Testing with the order inverted outside of the test harness
gave all manner of random errors and occasional success. I haven't
understood what is going on. That said, deliberately triggering a
sequence of deliberate errors like this is highly artificial since I
suppose that they would normally individually lead to termination of
execution.
Bootstrapped and regtested on FC28/x86_64 - OK for trunk?
Paul
2019-01-07 Paul Thomas <pault@gcc.gnu.org>
* trans-array.c (gfc_conv_descriptor_attribute): New function.
(gfc_get_dataptr_offset): Remove static function attribute.
* trans-array.h : Add prototypes for above functions.
* trans-decl.c : Add declarations for the library functions
cfi_desc_to_gfc_desc and gfc_desc_to_cfi_desc.
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): New function.
(gfc_conv_procedure_call): Call it for scalar and array actual
arguments, when the formal arguments are bind_c with assumed
shape or assumed rank.
* trans.h : External declarations for gfor_fndecl_cfi_to_gfc
and gfor_fndecl_gfc_to_cfi.
2019-01-07 Paul Thomas <pault@gcc.gnu.org>
* gfortran.dg/ISO_Fortran_binding_1.f90 : New test.
* gfortran.dg/ISO_Fortran_binding_1.c : Auxilliary file for test.
* gfortran.dg/ISO_Fortran_binding_2.f90 : New test.
* gfortran.dg/ISO_Fortran_binding_2.c : Auxilliary file for test.
* gfortran.dg/ISO_Fortran_binding.h : Auxilliary file for test.
* gfortran.dg/bind_c_array_params_2.f90 : Change search string
for dump tree scan.
2019-01-07 Paul Thomas <pault@gcc.gnu.org>
* ISO_Fortran_binding.h : New file.
* Makefile.am : Include ISO_Fortran_binding.c in the list of
files to compile.
* Makefile.in : Regenerated.
* gfortran.map : Add _gfortran_cfi_desc_to_gfc_desc,
_gfortran_gfc_desc_to_cfi_desc and the CFI API functions.
* runtime/ISO_Fortran_binding.c : New file containing the new
functions added to the map.
[-- Attachment #2: resubmit.diff --]
[-- Type: text/x-patch, Size: 113657 bytes --]
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 267421)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_descriptor_rank (tree desc)
*** 293,298 ****
--- 293,314 ----
tree
+ gfc_conv_descriptor_attribute (tree desc)
+ {
+ tree tmp;
+ tree dtype;
+
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)),
+ GFC_DTYPE_ATTRIBUTE);
+ gcc_assert (tmp!= NULL_TREE
+ && TREE_TYPE (tmp) == short_integer_type_node);
+ return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+ dtype, tmp, NULL_TREE);
+ }
+
+
+ tree
gfc_get_descriptor_dimension (tree desc)
{
tree type, field;
*************** gfc_trans_dummy_array_bias (gfc_symbol *
*** 6767,6773 ****
/* Calculate the overall offset, including subreferences. */
! static void
gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
bool subref, gfc_expr *expr)
{
--- 6783,6789 ----
/* Calculate the overall offset, including subreferences. */
! void
gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
bool subref, gfc_expr *expr)
{
Index: gcc/fortran/trans-array.h
===================================================================
*** gcc/fortran/trans-array.h (revision 267421)
--- gcc/fortran/trans-array.h (working copy)
*************** void gfc_conv_tmp_array_ref (gfc_se * se
*** 136,141 ****
--- 136,143 ----
/* Translate a reference to an array temporary. */
void gfc_conv_tmp_ref (gfc_se *);
+ /* Calculate the overall offset, including subreferences. */
+ void gfc_get_dataptr_offset (stmtblock_t*, tree, tree, tree, bool, gfc_expr*);
/* Obtain the span of an array. */
tree gfc_get_array_span (tree, gfc_expr *);
/* Evaluate an array expression. */
*************** tree gfc_conv_descriptor_offset_get (tre
*** 167,172 ****
--- 169,175 ----
tree gfc_conv_descriptor_span_get (tree);
tree gfc_conv_descriptor_dtype (tree);
tree gfc_conv_descriptor_rank (tree);
+ tree gfc_conv_descriptor_attribute (tree);
tree gfc_get_descriptor_dimension (tree);
tree gfc_conv_descriptor_stride_get (tree, tree);
tree gfc_conv_descriptor_lbound_get (tree, tree);
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 267421)
--- gcc/fortran/trans-decl.c (working copy)
*************** tree gfor_fndecl_fdate;
*** 114,119 ****
--- 114,121 ----
tree gfor_fndecl_ttynam;
tree gfor_fndecl_in_pack;
tree gfor_fndecl_in_unpack;
+ tree gfor_fndecl_cfi_to_gfc;
+ tree gfor_fndecl_gfc_to_cfi;
tree gfor_fndecl_associated;
tree gfor_fndecl_system_clock4;
tree gfor_fndecl_system_clock8;
*************** gfc_build_builtin_function_decls (void)
*** 3612,3617 ****
--- 3614,3627 ----
get_identifier (PREFIX("internal_unpack")), ".wR",
void_type_node, 2, pvoid_type_node, pvoid_type_node);
+ gfor_fndecl_cfi_to_gfc = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("cfi_desc_to_gfc_desc")), ".ww",
+ void_type_node, 2, pvoid_type_node, ppvoid_type_node);
+
+ gfor_fndecl_gfc_to_cfi = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("gfc_desc_to_cfi_desc")), ".wR",
+ void_type_node, 2, ppvoid_type_node, pvoid_type_node);
+
gfor_fndecl_associated = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("associated")), ".RR",
integer_type_node, 2, ppvoid_type_node, ppvoid_type_node);
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 267421)
--- gcc/fortran/trans-expr.c (working copy)
*************** expr_may_alias_variables (gfc_expr *e, b
*** 4891,4896 ****
--- 4891,4992 ----
}
+ /* Provide an interface between gfortran array descriptors and the F2018:18.4
+ ISO_Fortran_binding array descriptors. */
+
+ static void
+ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
+ {
+ tree tmp;
+ tree cfi_desc_ptr;
+ tree gfc_desc_ptr;
+ tree type;
+ int attribute;
+ symbol_attribute attr = gfc_expr_attr (e);
+
+ /* If this is a full array or a scalar, the allocatable and pointer
+ attributes can be passed. Otherwise it is 'CFI_attribute_other'*/
+ attribute = 2;
+ if (!e->rank || gfc_get_full_arrayspec_from_expr (e))
+ {
+ if (attr.pointer)
+ attribute = 0;
+ else if (attr.allocatable)
+ attribute = 1;
+ }
+
+ if (e->rank)
+ {
+ gfc_conv_expr_descriptor (parmse, e);
+
+ /* All the temporary descriptors are marked as DECL_ARTIFICIAL. If
+ the expression type is different from the descriptor type, then
+ the offset must be found (eg. to a component ref or substring)
+ and the dtype updated. */
+ type = gfc_typenode_for_spec (&e->ts);
+ if (DECL_ARTIFICIAL (parmse->expr)
+ && type != gfc_get_element_type (TREE_TYPE (parmse->expr)))
+ {
+ /* Obtain the offset to the data. */
+ gfc_get_dataptr_offset (&parmse->pre, parmse->expr, parmse->expr,
+ gfc_index_zero_node, true, e);
+
+ /* Update the dtype. */
+ gfc_add_modify (&parmse->pre,
+ gfc_conv_descriptor_dtype (parmse->expr),
+ gfc_get_dtype_rank_type (e->rank, type));
+ }
+ else if (!is_subref_array (e) && !DECL_ARTIFICIAL (parmse->expr))
+ {
+ /* Make sure that the span is set for expressions where it
+ might not have been done already. */
+ tmp = TREE_TYPE (parmse->expr);
+ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp));
+ tmp = fold_convert (gfc_array_index_type, tmp);
+ gfc_conv_descriptor_span_set (&parmse->pre, parmse->expr, tmp);
+ }
+ }
+ else
+ {
+ gfc_conv_expr (parmse, e);
+ /* Copy the scalar for INTENT_IN. */
+ if (e->expr_type == EXPR_VARIABLE && fsym->attr.intent == INTENT_IN)
+ parmse->expr = gfc_evaluate_now (parmse->expr, &parmse->pre);
+ parmse->expr = gfc_conv_scalar_to_descriptor (parmse,
+ parmse->expr, attr);
+ }
+
+ /* Set the CFI attribute field. */
+ tmp = gfc_conv_descriptor_attribute (parmse->expr);
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+ void_type_node, tmp,
+ build_int_cst (TREE_TYPE (tmp), attribute));
+ gfc_add_expr_to_block (&parmse->pre, tmp);
+
+ /* Now pass the gfc_descriptor by reference. */
+ parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
+
+ /* Variables to point to the gfc and CFI descriptors. */
+ gfc_desc_ptr = parmse->expr;
+ cfi_desc_ptr = gfc_create_var (pvoid_type_node, "cfi");
+
+ /* Allocate the CFI descriptor and fill the fields. */
+ tmp = gfc_build_addr_expr (NULL_TREE, cfi_desc_ptr);
+ tmp = build_call_expr_loc (input_location,
+ gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
+ gfc_add_expr_to_block (&parmse->pre, tmp);
+
+ /* The CFI descriptor is passed to the bind_C procedure. */
+ parmse->expr = cfi_desc_ptr;
+
+ /* Transfer values back to gfc descriptor and free the CFI descriptor. */
+ tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
+ tmp = build_call_expr_loc (input_location,
+ gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
+ gfc_prepend_expr_to_block (&parmse->post, tmp);
+ }
+
+
/* Generate code for a procedure call. Note can return se->post != NULL.
If se->direct_byref is set then se->expr contains the return parameter.
Return nonzero, if the call has alternate specifiers.
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5234,5240 ****
tmp = gfc_get_symbol_decl (e->symtree->n.sym->cp_pointer);
parmse.expr = convert (type, tmp);
}
! else if (fsym && fsym->attr.value)
{
if (fsym->ts.type == BT_CHARACTER
&& fsym->ts.is_c_interop
--- 5330,5344 ----
tmp = gfc_get_symbol_decl (e->symtree->n.sym->cp_pointer);
parmse.expr = convert (type, tmp);
}
!
! else if (sym->attr.is_bind_c && e
! && fsym && fsym->attr.dimension
! && (fsym->as->type == AS_ASSUMED_RANK
! || fsym->as->type == AS_ASSUMED_SHAPE))
! /* Implement F2018, C.12.6.1: paragraph (2). */
! gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
!
! else if (fsym && fsym->attr.value)
{
if (fsym->ts.type == BT_CHARACTER
&& fsym->ts.is_c_interop
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5273,5278 ****
--- 5377,5383 ----
}
}
}
+
else if (arg->name && arg->name[0] == '%')
/* Argument list functions %VAL, %LOC and %REF are signalled
through arg->name. */
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5287,5292 ****
--- 5392,5398 ----
gfc_conv_expr (&parmse, e);
parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
}
+
else if (e->expr_type == EXPR_FUNCTION
&& e->symtree->n.sym->result
&& e->symtree->n.sym->result != e->symtree->n.sym
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5297,5302 ****
--- 5403,5409 ----
if (fsym && fsym->attr.proc_pointer)
parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
}
+
else
{
if (e->ts.type == BT_CLASS && fsym
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5670,5676 ****
parmse.force_tmp = 1;
}
! if (e->expr_type == EXPR_VARIABLE
&& is_subref_array (e)
&& !(fsym && fsym->attr.pointer))
/* The actual argument is a component reference to an
--- 5777,5790 ----
parmse.force_tmp = 1;
}
! if (sym->attr.is_bind_c && e
! && fsym && fsym->attr.dimension
! && (fsym->as->type == AS_ASSUMED_RANK
! || fsym->as->type == AS_ASSUMED_SHAPE))
! /* Implement F2018, C.12.6.1: paragraph (2). */
! gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
!
! else if (e->expr_type == EXPR_VARIABLE
&& is_subref_array (e)
&& !(fsym && fsym->attr.pointer))
/* The actual argument is a component reference to an
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5680,5685 ****
--- 5794,5800 ----
gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
fsym ? fsym->attr.intent : INTENT_INOUT,
fsym && fsym->attr.pointer);
+
else if (gfc_is_class_array_ref (e, NULL)
&& fsym && fsym->ts.type == BT_DERIVED)
/* The actual argument is a component reference to an
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h (revision 267421)
--- gcc/fortran/trans.h (working copy)
*************** extern GTY(()) tree gfor_fndecl_ctime;
*** 801,806 ****
--- 801,808 ----
extern GTY(()) tree gfor_fndecl_fdate;
extern GTY(()) tree gfor_fndecl_in_pack;
extern GTY(()) tree gfor_fndecl_in_unpack;
+ extern GTY(()) tree gfor_fndecl_cfi_to_gfc;
+ extern GTY(()) tree gfor_fndecl_gfc_to_cfi;
extern GTY(()) tree gfor_fndecl_associated;
extern GTY(()) tree gfor_fndecl_system_clock4;
extern GTY(()) tree gfor_fndecl_system_clock8;
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding.h
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding.h (nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding.h (working copy)
***************
*** 0 ****
--- 1,206 ----
+ /* Declarations for ISO Fortran binding.
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Soren Rasmussen <s.c.rasmussen@gmail.com>
+
+ This file is part of the GNU Fortran runtime library (libgfortran).
+
+ Libgfortran is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgfortran is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+ #ifndef ISO_FORTRAN_BINDING_H
+ #define ISO_FORTRAN_BINDING_H
+
+ #ifdef __cplusplus
+ extern "C" {
+ #endif
+
+ #include <stddef.h> /* Standard ptrdiff_t tand size_t. */
+ #include <stdint.h> /* Integer types. */
+
+ /* Constants, defined as macros. */
+ #define CFI_VERSION 1
+ #define CFI_MAX_RANK 15
+
+ /* Attributes. */
+ #define CFI_attribute_pointer 0
+ #define CFI_attribute_allocatable 1
+ #define CFI_attribute_other 2
+
+ /* Error codes.
+ CFI_INVALID_STRIDE should be defined in the standard because they are useful to the implementation of the functions.
+ */
+ #define CFI_SUCCESS 0
+ #define CFI_FAILURE 1
+ #define CFI_ERROR_BASE_ADDR_NULL 2
+ #define CFI_ERROR_BASE_ADDR_NOT_NULL 3
+ #define CFI_INVALID_ELEM_LEN 4
+ #define CFI_INVALID_RANK 5
+ #define CFI_INVALID_TYPE 6
+ #define CFI_INVALID_ATTRIBUTE 7
+ #define CFI_INVALID_EXTENT 8
+ #define CFI_INVALID_STRIDE 9
+ #define CFI_INVALID_DESCRIPTOR 10
+ #define CFI_ERROR_MEM_ALLOCATION 11
+ #define CFI_ERROR_OUT_OF_BOUNDS 12
+
+ /* CFI type definitions. */
+ typedef ptrdiff_t CFI_index_t;
+ typedef int8_t CFI_rank_t;
+ typedef int8_t CFI_attribute_t;
+ typedef int16_t CFI_type_t;
+
+ /* CFI_dim_t. */
+ typedef struct CFI_dim_t
+ {
+ CFI_index_t lower_bound;
+ CFI_index_t extent;
+ CFI_index_t sm;
+ }
+ CFI_dim_t;
+
+ /* CFI_cdesc_t, C descriptors are cast to this structure as follows:
+ CFI_CDESC_T(CFI_MAX_RANK) foo;
+ CFI_cdesc_t * bar = (CFI_cdesc_t *) &foo;
+ */
+ typedef struct CFI_cdesc_t
+ {
+ void *base_addr;
+ size_t elem_len;
+ int version;
+ CFI_rank_t rank;
+ CFI_attribute_t attribute;
+ CFI_type_t type;
+ CFI_dim_t dim[];
+ }
+ CFI_cdesc_t;
+
+ /* CFI_CDESC_T with an explicit type. */
+ #define CFI_CDESC_TYPE_T(r, base_type) \
+ struct { \
+ base_type *base_addr; \
+ size_t elem_len; \
+ int version; \
+ CFI_rank_t rank; \
+ CFI_attribute_t attribute; \
+ CFI_type_t type; \
+ CFI_dim_t dim[r]; \
+ }
+ #define CFI_CDESC_T(r) CFI_CDESC_TYPE_T (r, void)
+
+ /* CFI function declarations. */
+ extern void *CFI_address (const CFI_cdesc_t *, const CFI_index_t []);
+ extern int CFI_allocate (CFI_cdesc_t *, const CFI_index_t [], const CFI_index_t [],
+ size_t);
+ extern int CFI_deallocate (CFI_cdesc_t *);
+ extern int CFI_establish (CFI_cdesc_t *, void *, CFI_attribute_t, CFI_type_t, size_t,
+ CFI_rank_t, const CFI_index_t []);
+ extern int CFI_is_contiguous (const CFI_cdesc_t *);
+ extern int CFI_section (CFI_cdesc_t *, const CFI_cdesc_t *, const CFI_index_t [],
+ const CFI_index_t [], const CFI_index_t []);
+ extern int CFI_select_part (CFI_cdesc_t *, const CFI_cdesc_t *, size_t, size_t);
+ extern int CFI_setpointer (CFI_cdesc_t *, CFI_cdesc_t *, const CFI_index_t []);
+
+ /* Types and kind numbers. Allows bitwise and to reveal the intrinsic type of a kind type. It also allows us to find the kind parameter by inverting the bit-shift equation.
+ CFI_type_kind_shift = 8
+ CFI_intrinsic_type = 0 0 0 0 0 0 0 0 0 0 1 0
+ CFI_type_kind = 0 0 0 0 0 0 0 0 1 0 0 0
+ CFI_type_example = CFI_intrinsic_type + (CFI_type_kind << CFI_type_kind_shift)
+ Defining the CFI_type_example.
+ CFI_type_kind = 0 0 0 0 0 0 0 0 1 0 0 0 << CFI_type_kind_shift
+ -------------------------
+ 1 0 0 0 0 0 0 0 0 0 0 0 +
+ CFI_intrinsic_type = 0 0 0 0 0 0 0 0 0 0 1 0
+ -------------------------
+ CFI_type_example = 1 0 0 0 0 0 0 0 0 0 1 0
+ Finding the intrinsic type with the logical mask.
+ CFI_type_example = 1 0 0 0 0 0 0 0 0 0 1 0 &
+ CFI_type_mask = 0 0 0 0 1 1 1 1 1 1 1 1
+ -------------------------
+ CFI_intrinsic_type = 0 0 0 0 0 0 0 0 0 0 1 0
+ Using the intrinsic type and kind shift to find the kind value of the type.
+ CFI_type_kind = (CFI_type_example - CFI_intrinsic_type) >> CFI_type_kind_shift
+ CFI_type_example = 1 0 0 0 0 0 0 0 0 0 1 0 -
+ CFI_intrinsic_type = 0 0 0 0 0 0 0 0 0 0 1 0
+ -------------------------
+ 1 0 0 0 0 0 0 0 0 0 0 0 >> CFI_type_kind_shift
+ -------------------------
+ CFI_type_kind = 0 0 0 0 0 0 0 0 1 0 0 0
+ */
+ #define CFI_type_mask 0xFF
+ #define CFI_type_kind_shift 8
+
+ /* Intrinsic types. Their kind number defines their storage size. */
+ #define CFI_type_Integer 1
+ #define CFI_type_Logical 2
+ #define CFI_type_Real 3
+ #define CFI_type_Complex 4
+ #define CFI_type_Character 5
+
+ /* Types with no kind. */
+ #define CFI_type_struct 6
+ #define CFI_type_cptr 7
+ #define CFI_type_cfunptr 8
+ #define CFI_type_other -1
+
+ /* Types with kind parameter.
+ The kind parameter represents the type's byte size. The exception is kind = 10, which has byte size of 64 but 80 bit precision. Complex variables are double the byte size of their real counterparts. The ucs4_char matches wchar_t if sizeof (wchar_t) == 4.
+ */
+ #define CFI_type_char (CFI_type_Character + (1 << CFI_type_kind_shift))
+ #define CFI_type_ucs4_char (CFI_type_Character + (4 << CFI_type_kind_shift))
+
+ /* C-Fortran Interoperability types. */
+ #define CFI_type_signed_char (CFI_type_Integer + (1 << CFI_type_kind_shift))
+ #define CFI_type_short (CFI_type_Integer + (2 << CFI_type_kind_shift))
+ #define CFI_type_int (CFI_type_Integer + (4 << CFI_type_kind_shift))
+ #define CFI_type_long (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_long_long (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_size_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_int8_t (CFI_type_Integer + (1 << CFI_type_kind_shift))
+ #define CFI_type_int16_t (CFI_type_Integer + (2 << CFI_type_kind_shift))
+ #define CFI_type_int32_t (CFI_type_Integer + (4 << CFI_type_kind_shift))
+ #define CFI_type_int64_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_int_least8_t (CFI_type_Integer + (1 << CFI_type_kind_shift))
+ #define CFI_type_int_least16_t (CFI_type_Integer + (2 << CFI_type_kind_shift))
+ #define CFI_type_int_least32_t (CFI_type_Integer + (4 << CFI_type_kind_shift))
+ #define CFI_type_int_least64_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_int_fast8_t (CFI_type_Integer + (1 << CFI_type_kind_shift))
+ #define CFI_type_int_fast16_t (CFI_type_Integer + (2 << CFI_type_kind_shift))
+ #define CFI_type_int_fast32_t (CFI_type_Integer + (4 << CFI_type_kind_shift))
+ #define CFI_type_int_fast64_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_intmax_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_intptr_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_ptrdiff_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_int128_t (CFI_type_Integer + (16 << CFI_type_kind_shift))
+ #define CFI_type_int_least128_t (CFI_type_Integer + (16 << CFI_type_kind_shift))
+ #define CFI_type_int_fast128_t (CFI_type_Integer + (16 << CFI_type_kind_shift))
+ #define CFI_type_Bool (CFI_type_Logical + (1 << CFI_type_kind_shift))
+ #define CFI_type_float (CFI_type_Real + (4 << CFI_type_kind_shift))
+ #define CFI_type_double (CFI_type_Real + (8 << CFI_type_kind_shift))
+ #define CFI_type_long_double (CFI_type_Real + (10 << CFI_type_kind_shift))
+ #define CFI_type_float128 (CFI_type_Real + (16 << CFI_type_kind_shift))
+ #define CFI_type_float_Complex (CFI_type_Complex + (4 << CFI_type_kind_shift))
+ #define CFI_type_double_Complex (CFI_type_Complex + (8 << CFI_type_kind_shift))
+ #define CFI_type_long_double_Complex (CFI_type_Complex + (10 << CFI_type_kind_shift))
+ #define CFI_type_float128_Complex (CFI_type_Complex + (16 << CFI_type_kind_shift))
+
+ #ifdef __cplusplus
+ }
+ #endif
+
+ #endif /* ISO_FORTRAN_BINDING_H */
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c (nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c (working copy)
***************
*** 0 ****
--- 1,205 ----
+ /* Test F2008 18.5: ISO_Fortran_binding.h functions. */
+
+ #include "ISO_Fortran_binding.h"
+ #include <stdio.h>
+ #include <stdlib.h>
+ #include <complex.h>
+
+ /* Test the example in F2008 C.12.9: Processing assumed-shape arrays in C,
+ modified to use CFI_address instead of pointer arithmetic. */
+
+ int elemental_mult_c(CFI_cdesc_t * a_desc, CFI_cdesc_t * b_desc,
+ CFI_cdesc_t * c_desc)
+ {
+ CFI_index_t idx[2];
+ int *res_addr;
+ int err = 1; /* this error code represents all errors */
+
+ if (a_desc->rank == 0)
+ {
+ err = *(int*)a_desc->base_addr;
+ *(int*)a_desc->base_addr = 0;
+ return err;
+ }
+
+ if (a_desc->type != CFI_type_int
+ || b_desc->type != CFI_type_int
+ || c_desc->type != CFI_type_int)
+ return err;
+
+ /* Only support two dimensions. */
+ if (a_desc->rank != 2
+ || b_desc->rank != 2
+ || c_desc->rank != 2)
+ return err;
+
+ for (idx[0] = 0; idx[0] < a_desc->dim[0].extent; idx[0]++)
+ for (idx[1] = 0; idx[1] < a_desc->dim[1].extent; idx[1]++)
+ {
+ res_addr = CFI_address (a_desc, idx);
+ *res_addr = *(int*)CFI_address (b_desc, idx)
+ * *(int*)CFI_address (c_desc, idx);
+ }
+
+ return 0;
+ }
+
+
+ int deallocate_c(CFI_cdesc_t * dd)
+ {
+ return CFI_deallocate(dd);
+ }
+
+
+ int allocate_c(CFI_cdesc_t * da, CFI_index_t lower[], CFI_index_t upper[])
+ {
+ int err = 1;
+ CFI_index_t idx[2];
+ int *res_addr;
+
+ if (CFI_allocate(da, lower, upper, 0)) return err;
+
+
+ for (idx[0] = 0; idx[0] < da->dim[0].extent; idx[0]++)
+ for (idx[1] = 0; idx[1] < da->dim[1].extent; idx[1]++)
+ {
+ res_addr = CFI_address (da, idx);
+ *res_addr = (int)((idx[0] + da->dim[0].lower_bound)
+ * (idx[1] + da->dim[1].lower_bound));
+ }
+
+ return 0;
+ }
+
+ int establish_c(CFI_cdesc_t * desc)
+ {
+ typedef struct {double x; double _Complex y;} t;
+ int err;
+ CFI_index_t idx[1], extent[1];
+ t *res_addr;
+ double value = 1.0;
+ double complex z_value = 0.0 + 2.0 * I;
+
+ extent[0] = 10;
+ err = CFI_establish((CFI_cdesc_t *)desc,
+ malloc ((size_t)(extent[0] * sizeof(t))),
+ CFI_attribute_pointer,
+ CFI_type_struct,
+ sizeof(t), 1, extent);
+ for (idx[0] = 0; idx[0] < extent[0]; idx[0]++)
+ {
+ res_addr = (t*)CFI_address (desc, idx);
+ res_addr->x = value++;
+ res_addr->y = z_value * (idx[0] + 1);
+ }
+ return err;
+ }
+
+ int contiguous_c(CFI_cdesc_t * desc)
+ {
+ return CFI_is_contiguous(desc);
+ }
+
+ float section_c(int *std_case, CFI_cdesc_t * source, int *low, int *str)
+ {
+ CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
+ strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
+ CFI_CDESC_T(1) section;
+ int ind, size;
+ float *ret_addr;
+ float ans = 0.0;
+
+ /* Case (i) from F2018:18.5.5.7. */
+ if (*std_case == 1)
+ {
+ lower[0] = (CFI_index_t)low[0];
+ strides[0] = (CFI_index_t)str[0];
+ ind = CFI_establish((CFI_cdesc_t *)§ion, NULL, CFI_attribute_other,
+ CFI_type_float, 0, 1, NULL);
+ if (ind) return -1.0;
+ ind = CFI_section((CFI_cdesc_t *)§ion, source, lower, NULL, strides);
+ if (ind) return -2.0;
+
+ /* Sum over the section */
+ size = (section.dim[0].extent - 1)
+ * section.elem_len/section.dim[0].sm + 1;
+ for (idx[0] = 0; idx[0] < size; idx[0]++)
+ ans += *(float*)CFI_address ((CFI_cdesc_t*)§ion, idx);
+ return ans;
+ }
+ else if (*std_case == 2)
+ {
+ int ind;
+ lower[0] = source->dim[0].lower_bound;
+ upper[0] = source->dim[0].lower_bound + source->dim[0].extent - 1;
+ strides[0] = str[0];
+ lower[1] = upper[1] = source->dim[1].lower_bound + low[1] - 1;
+ strides[1] = 0;
+ ind = CFI_establish((CFI_cdesc_t *)§ion, NULL, CFI_attribute_other,
+ CFI_type_float, 0, 1, NULL);
+ if (ind) return -1.0;
+ ind = CFI_section((CFI_cdesc_t *)§ion, source,
+ lower, upper, strides);
+ if (ind) return -2.0;
+
+ /* Sum over the section */
+ size = (section.dim[0].extent - 1)
+ * section.elem_len/section.dim[0].sm + 1;
+ for (idx[0] = 0; idx[0] < size; idx[0]++)
+ ans += *(float*)CFI_address ((CFI_cdesc_t*)§ion, idx);
+ return ans;
+ }
+
+ return 0.0;
+ }
+
+
+ double select_part_c (CFI_cdesc_t * source)
+ {
+ typedef struct {
+ double x; double _Complex y;
+ } t;
+ CFI_CDESC_T(2) component;
+ CFI_cdesc_t * comp_cdesc = (CFI_cdesc_t *)&component;
+ CFI_index_t extent[] = {10,10};
+ CFI_index_t idx[] = {4,0};
+ double ans = 0.0;
+ int size;
+
+ (void)CFI_establish(comp_cdesc, NULL, CFI_attribute_other,
+ CFI_type_double_Complex, sizeof(double _Complex),
+ 2, extent);
+ (void)CFI_select_part(comp_cdesc, source, offsetof(t,y), 0);
+
+ /* Sum over comp_cdesc[4,:] */
+ size = comp_cdesc->dim[1].extent;
+ for (idx[1] = 0; idx[1] < size; idx[1]++)
+ ans += cimag (*(double _Complex*)CFI_address ((CFI_cdesc_t*)comp_cdesc,
+ idx));
+ return ans;
+ }
+
+
+ int setpointer_c(CFI_cdesc_t * ptr, int lbounds[])
+ {
+ CFI_index_t lower_bounds[] = {lbounds[0],lbounds[1]};
+ int ind;
+ ind = CFI_setpointer(ptr, ptr, lower_bounds);
+ return ind;
+ }
+
+
+ int assumed_size_c(CFI_cdesc_t * desc)
+ {
+ int ierr;
+
+ ierr = CFI_is_contiguous(desc);
+ if (ierr)
+ return 1;
+ if (desc->rank)
+ ierr = 2 * (desc->dim[desc->rank-1].extent
+ != (CFI_index_t)(long long)(-1));
+ else
+ ierr = 3;
+ return ierr;
+ }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.f90 (working copy)
***************
*** 0 ****
--- 1,244 ----
+ ! { dg-do run }
+ ! { dg-additional-sources ISO_Fortran_binding_1.c }
+ !
+ ! Test F2008 18.5: ISO_Fortran_binding.h functions.
+ !
+ USE, INTRINSIC :: ISO_C_BINDING
+
+ TYPE, BIND(C) :: T
+ REAL(C_DOUBLE) :: X
+ complex(C_DOUBLE_COMPLEX) :: Y
+ END TYPE
+
+ type :: mytype
+ integer :: i
+ integer :: j
+ end type
+
+ INTERFACE
+ FUNCTION elemental_mult(a, b, c) BIND(C, NAME="elemental_mult_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), DIMENSION(..) :: a, b, c
+ END FUNCTION elemental_mult
+
+ FUNCTION c_deallocate(a) BIND(C, NAME="deallocate_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_deallocate
+
+ FUNCTION c_allocate(a, lower, upper) BIND(C, NAME="allocate_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), DIMENSION(..) :: a
+ integer(C_INTPTR_T), DIMENSION(15) :: lower, upper
+ END FUNCTION c_allocate
+
+ FUNCTION c_establish(a) BIND(C, NAME="establish_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ import
+ INTEGER(C_INT) :: err
+ type (T), DIMENSION(..), intent(out) :: a
+ END FUNCTION c_establish
+
+ FUNCTION c_contiguous(a) BIND(C, NAME="contiguous_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_contiguous
+
+ FUNCTION c_section(std_case, a, lower, strides) BIND(C, NAME="section_c") RESULT(ans)
+ USE, INTRINSIC :: ISO_C_BINDING
+ real(C_FLOAT) :: ans
+ INTEGER(C_INT) :: std_case
+ INTEGER(C_INT), dimension(15) :: lower
+ INTEGER(C_INT), dimension(15) :: strides
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_section
+
+ FUNCTION c_select_part(a) BIND(C, NAME="select_part_c") RESULT(ans)
+ USE, INTRINSIC :: ISO_C_BINDING
+ real(C_DOUBLE) :: ans
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_select_part
+
+ FUNCTION c_setpointer(a, lbounds) BIND(C, NAME="setpointer_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ INTEGER(C_INT), dimension(2) :: lbounds
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_setpointer
+
+ FUNCTION c_assumed_size(a) BIND(C, NAME="assumed_size_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_assumed_size
+
+ END INTERFACE
+
+ integer, dimension(:,:), allocatable :: x, y, z
+ integer, dimension(2,2) :: a, b, c
+ integer, dimension(4,4) :: d
+ integer :: i = 42, j, k
+ integer(C_INTPTR_T), dimension(15) :: lower, upper
+ real, dimension(10,10) :: arg
+ type (mytype), dimension(2,2) :: der
+
+ allocate (x, source = reshape ([4,3,2,1], [2,2]))
+ allocate (y, source = reshape ([2,3,4,5], [2,2]))
+ allocate (z, source = reshape ([0,0,0,0], [2,2]))
+
+ call test_CFI_address
+ call test_CFI_deallocate
+ call test_CFI_allocate
+ call test_CFI_establish
+ call test_CFI_contiguous (a)
+ call test_CFI_section (arg)
+ call test_CFI_select_part
+ call test_CFI_setpointer
+ call test_assumed_size (a)
+ contains
+ subroutine test_CFI_address
+ ! Basic test that CFI_desc_t can be passed and that CFI_address works
+ if (elemental_mult (z, x, y) .ne. 0) stop 1
+ if (any (z .ne. reshape ([8,9,8,5], [2,2]))) stop 2
+
+ a = reshape ([4,3,2,1], [2,2])
+ b = reshape ([2,3,4,5], [2,2])
+ c = 0
+ ! Verify that components of arrays of derived types are OK.
+ der%j = a
+ ! Check that non-pointer/non-allocatable arguments are OK
+ if (elemental_mult (c, der%j, b) .ne. 0) stop 3
+ if (any (c .ne. reshape ([8,9,8,5], [2,2]))) stop 4
+
+ ! Check array sections
+ d = 0
+ d(4:2:-2, 1:3:2) = b
+ if (elemental_mult (c, a, d(4:2:-2, 1:3:2)) .ne. 0) stop 5
+ if (any (c .ne. reshape ([8,9,8,5], [2,2]))) stop 6
+
+ ! If a scalar result is passed to 'elemental_mult' it is returned
+ ! as the function result and then zeroed. This tests that scalars
+ ! are correctly converted to CF_desc_t.
+ if ((elemental_mult (i, a, b) .ne. 42) &
+ .or. (i .ne. 0)) stop 7
+ deallocate (y,z)
+ end subroutine test_CFI_address
+
+ subroutine test_CFI_deallocate
+ ! Test CFI_deallocate.
+ if (c_deallocate (x) .ne. 0) stop 8
+ if (allocated (x)) stop 9
+ end subroutine test_CFI_deallocate
+
+ subroutine test_CFI_allocate
+ ! Test CFI_allocate.
+ lower(1:2) = [2,2]
+ upper(1:2) = [10,10]
+
+ if (c_allocate (x, lower, upper) .ne. 0) stop 10
+ if (.not.allocated (x)) stop 11
+ if (any (lbound (x) .ne. lower(1:2))) stop 12
+ if (any (ubound (x) .ne. upper(1:2))) stop 13
+
+ ! Elements are filled by 'c_allocate' with the product of the fortran indices
+ do j = lower(1) , upper(1)
+ do k = lower(2) , upper(2)
+ x(j,k) = x(j,k) - j * k
+ end do
+ end do
+ if (any (x .ne. 0)) stop 14
+ deallocate (x)
+ end subroutine test_CFI_allocate
+
+ subroutine test_CFI_establish
+ ! Test CFI_establish.
+ type(T), pointer :: case2(:) => null()
+ if (c_establish(case2) .ne. 0) stop 14
+ if (ubound(case2, 1) .ne. 9) stop 15
+ if (.not.associated(case2)) stop 16
+ if (sizeof(case2) .ne. 240) stop 17
+ if (int (sum (case2%x)) .ne. 55) stop 18
+ if (int (sum (imag (case2%y))) .ne. 110) stop 19
+ deallocate (case2)
+ end subroutine test_CFI_establish
+
+ subroutine test_CFI_contiguous (arg)
+ integer, dimension (2,*) :: arg
+ character(4), dimension(2) :: chr
+ ! These are contiguous
+ if (c_contiguous (arg) .ne. 0) stop 20
+ if (.not.allocated (x)) allocate (x(2, 2))
+ if (c_contiguous (x) .ne. 0) stop 22
+ deallocate (x)
+ if (c_contiguous (chr) .ne. 0) stop 23
+ ! These are not contiguous
+ if (c_contiguous (der%i) .eq. 0) stop 24
+ if (c_contiguous (arg(1:1,1:2)) .eq. 0) stop 25
+ if (c_contiguous (d(4:2:-2, 1:3:2)) .eq. 0) stop 26
+ if (c_contiguous (chr(:)(2:3)) .eq. 0) stop 27
+ end subroutine test_CFI_contiguous
+
+ subroutine test_CFI_section (arg)
+ real, dimension (100) :: a
+ real, dimension (10,*) :: arg
+ integer, dimension(15) :: lower, strides
+ integer :: i
+
+ ! Case (i) from F2018:18.5.5.7.
+ a = [(real(i), i = 1, 100)]
+ lower(1) = 10
+ strides(1) = 5
+ if (int (sum(a(lower(1)::strides(1))) &
+ - c_section(1, a, lower, strides)) .ne. 0) stop 28
+ ! Case (ii) from F2018:18.5.5.7.
+ arg(:,1:10) = reshape ([(real(i), i = 1, 100)], [10,10])
+ lower(1) = 1
+ lower(2) = 5
+ strides(1) = 1
+ strides(2) = 0
+ if (int (sum(arg(:,5)) &
+ - c_section (2, arg, lower, strides)) .ne. 0) stop 29
+ end subroutine test_CFI_section
+
+ subroutine test_CFI_select_part
+ ! Test the example from F2018:18.5.5.8.
+ ! Modify to take rank 2 and sum the section type_t(5, :)%y%im
+ ! Note that sum_z_5 = sum (type_t(5, :)%y%im) is broken on Darwin.
+ !
+ type (t), dimension(10, 10) :: type_t
+ real(kind(type_t%x)) :: v, sum_z_5 = 0.0
+ complex(kind(type_t%y)) :: z
+ ! Set the array 'type_t'.
+ do j = 1, 10
+ do k = 1, 10
+ v = dble (j * k)
+ z = cmplx (2 * v, 3 * v)
+ type_t(j, k) = t (v, z)
+ if (j .eq. 5) sum_z_5 = sum_z_5 + imag (z)
+ end do
+ end do
+ ! Now do the test.
+ if (int (c_select_part (type_t) - sum_z_5) .ne. 0) stop 28
+ end subroutine test_CFI_select_part
+
+ subroutine test_CFI_setpointer
+ ! Test the example from F2018:18.5.5.9.
+ integer, dimension(:,:), pointer :: ptr => NULL ()
+ integer, dimension(2,2), target :: tgt
+ integer, dimension(2) :: lbounds = [-1, -2]
+ ! The C-function resets the lbounds
+ ptr(1:, 1:) => tgt
+ if (c_setpointer (ptr, lbounds) .ne. 0) stop 30
+ if (any (lbound(ptr) .ne. lbounds)) stop 31
+ end subroutine test_CFI_setpointer
+
+ subroutine test_assumed_size (arg)
+ integer, dimension(2,*) :: arg
+ ! The C-function checks contiguousness and that extent[1] == -1.
+ if (c_assumed_size (arg) .ne. 0) stop 32
+ end subroutine
+ end
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_2.c
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_2.c (nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_2.c (working copy)
***************
*** 0 ****
--- 1,115 ----
+ /* Test F2018 18.5: ISO_Fortran_binding.h functions. */
+
+ #include "ISO_Fortran_binding.h"
+ #include <stdio.h>
+ #include <stdlib.h>
+ #include <complex.h>
+
+ /* Test the example in F2018 C.12.9: Processing assumed-shape arrays in C,
+ modified to use CFI_address instead of pointer arithmetic. */
+
+ int address_c(CFI_cdesc_t * a_desc, const int idx[])
+ {
+ int *res_addr;
+ CFI_index_t CFI_idx[1];
+
+ CFI_idx[0] = (CFI_index_t)idx[0];
+
+ res_addr = CFI_address (a_desc, CFI_idx);
+ if (res_addr == NULL)
+ return -1;
+ return *res_addr;
+ }
+
+
+ int deallocate_c(CFI_cdesc_t * dd)
+ {
+ return CFI_deallocate(dd);
+ }
+
+
+ int allocate_c(CFI_cdesc_t * da, CFI_index_t lower[], CFI_index_t upper[])
+ {
+ return CFI_allocate(da, lower, upper, 0);
+ }
+
+ int establish_c(CFI_cdesc_t * desc, int *rank, int *attr)
+ {
+ typedef struct {double x; double _Complex y;} t;
+ int err;
+ CFI_index_t idx[1], extent[1];
+ void *ptr;
+
+ extent[0] = 1;
+ ptr = malloc ((size_t)(extent[0] * sizeof(t)));
+ err = CFI_establish((CFI_cdesc_t *)desc,
+ ptr,
+ (CFI_attribute_t)*attr,
+ CFI_type_struct,
+ sizeof(t), (CFI_rank_t)*rank, extent);
+ free (ptr);
+ return err;
+ }
+
+ int contiguous_c(CFI_cdesc_t * desc)
+ {
+ return CFI_is_contiguous(desc);
+ }
+
+ float section_c(int *std_case, CFI_cdesc_t * source, int *low, int *str)
+ {
+ CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
+ strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
+ CFI_CDESC_T(1) section;
+ int ind, size;
+ float *ret_addr;
+ float ans = 0.0;
+
+ if (*std_case == 1)
+ {
+ lower[0] = (CFI_index_t)low[0];
+ strides[0] = (CFI_index_t)str[0];
+ ind = CFI_establish((CFI_cdesc_t *)§ion, NULL, CFI_attribute_other,
+ CFI_type_float, 0, 1, NULL);
+ if (ind) return -1.0;
+ ind = CFI_section((CFI_cdesc_t *)§ion, source, lower, NULL, strides);
+ if (ind) return (float)ind;
+ }
+
+ return 0.0;
+ }
+
+
+ int select_part_c (CFI_cdesc_t * source)
+ {
+ typedef struct
+ {
+ double x;
+ double _Complex y;
+ } t;
+ CFI_CDESC_T(2) component;
+ CFI_cdesc_t * comp_cdesc = (CFI_cdesc_t *)&component;
+ CFI_index_t extent[] = {10,10};
+ CFI_index_t idx[] = {4,0};
+ int res;
+
+ res = CFI_establish(comp_cdesc, NULL, CFI_attribute_other,
+ CFI_type_double_Complex, sizeof(double _Complex),
+ 2, extent);
+ if (res)
+ return res;
+
+ res = CFI_select_part(comp_cdesc, source, offsetof(t,y), 0);
+
+ return res;
+ }
+
+
+ int setpointer_c(CFI_cdesc_t * ptr1, CFI_cdesc_t * ptr2, int lbounds[])
+ {
+ CFI_index_t lower_bounds[] = {lbounds[0],lbounds[1]};
+ int ind;
+
+ ind = CFI_setpointer(ptr1, ptr2, lower_bounds);
+ return ind;
+ }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_2.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_2.f90 (working copy)
***************
*** 0 ****
--- 1,193 ----
+ ! { dg-do run }
+ ! { dg-additional-sources ISO_Fortran_binding_2.c }
+ ! { dg-options "-fbounds-check" }
+ !
+ ! Test F2018 18.5: ISO_Fortran_binding.h function errors.
+ !
+ USE, INTRINSIC :: ISO_C_BINDING
+
+ TYPE, BIND(C) :: T
+ REAL(C_DOUBLE) :: X
+ complex(C_DOUBLE_COMPLEX) :: Y
+ END TYPE
+
+ type :: mytype
+ integer :: i
+ integer :: j
+ end type
+
+ INTERFACE
+ FUNCTION c_address(a, idx) BIND(C, NAME="address_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ INTEGER(C_INT), dimension(1) :: idx
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_address
+
+ FUNCTION c_deallocate(a) BIND(C, NAME="deallocate_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_deallocate
+
+ FUNCTION c_allocate(a, lower, upper) BIND(C, NAME="allocate_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), DIMENSION(..) :: a
+ integer(C_INTPTR_T), DIMENSION(15) :: lower, upper
+ END FUNCTION c_allocate
+
+ FUNCTION c_establish(a, rank, attr) BIND(C, NAME="establish_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ import
+ INTEGER(C_INT) :: err
+ INTEGER(C_INT) :: rank, attr
+ type (T), DIMENSION(..), intent(out) :: a
+ END FUNCTION c_establish
+
+ FUNCTION c_contiguous(a) BIND(C, NAME="contiguous_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_contiguous
+
+ FUNCTION c_section(std_case, a, lower, strides) BIND(C, NAME="section_c") RESULT(ans)
+ USE, INTRINSIC :: ISO_C_BINDING
+ real(C_FLOAT) :: ans
+ INTEGER(C_INT) :: std_case
+ INTEGER(C_INT), dimension(15) :: lower
+ INTEGER(C_INT), dimension(15) :: strides
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_section
+
+ FUNCTION c_select_part(a) BIND(C, NAME="select_part_c") RESULT(ans)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: ans
+ type(*), DIMENSION(..) :: a
+ END FUNCTION c_select_part
+
+ FUNCTION c_setpointer(a, b, lbounds) BIND(C, NAME="setpointer_c") RESULT(err)
+ USE, INTRINSIC :: ISO_C_BINDING
+ INTEGER(C_INT) :: err
+ INTEGER(C_INT), dimension(2) :: lbounds
+ type(*), DIMENSION(..) :: a, b
+ END FUNCTION c_setpointer
+ END INTERFACE
+
+ integer(C_INTPTR_T), dimension(15) :: lower, upper
+
+ call test_CFI_address
+ call test_CFI_deallocate
+ call test_CFI_allocate
+ call test_CFI_establish
+ call test_CFI_contiguous
+ call test_CFI_section
+ call test_CFI_select_part
+ call test_CFI_setpointer
+
+ contains
+ subroutine test_CFI_address
+ integer, dimension(:), allocatable :: a
+ allocate (a, source = [1,2,3])
+ if (c_address (a, [2]) .ne. 3) stop 1 ! OK
+ if (c_address (a, [3]) .ne. -1) stop 2 ! "subscripts[0], is out of bounds"
+ if (c_address (a, [-1]) .ne. -1) stop 3 ! "subscripts[0], is out of bounds"
+ deallocate (a)
+ if (c_address (a, [2]) .ne. -1) stop 4 ! "C Descriptor must not be NULL"
+ end subroutine test_CFI_address
+
+ subroutine test_CFI_deallocate
+ integer, dimension(:), allocatable :: a
+ integer, dimension(2,2) :: b
+ if (c_deallocate (a) .ne. 2) stop 5 ! "Base address is already NULL"
+ allocate (a(2))
+ if (c_deallocate (a) .ne. 0) stop 6 ! OK
+ if (c_deallocate (b) .ne. 7) stop 7 ! "must describe a pointer or allocatable"
+ end subroutine test_CFI_deallocate
+
+ subroutine test_CFI_allocate
+ integer, dimension(:,:), allocatable :: a
+ integer, dimension(2,2) :: b
+ lower(1:2) = [2,2]
+ upper(1:2) = [10,10]
+ allocate (a(1,1))
+ if (c_allocate (a, lower, upper) .ne. 3) stop 8 ! "C descriptor must be NULL"
+ if (allocated (a)) deallocate (a)
+ if (c_allocate (a, lower, upper) .ne. 0) stop 9 ! OK
+ if (c_allocate (b, lower, upper) .ne. 7) STOP 10 ! "must describe a pointer or allocatable"
+ end subroutine test_CFI_allocate
+
+ subroutine test_CFI_establish
+ type(T), allocatable :: a(:)
+ INTEGER(C_INT) :: rank
+ INTEGER(C_INT) :: attr
+ attr = 0 ! establish a pointer
+ rank = 16
+ if (c_establish (a, rank, attr) .ne. 5) stop 11 ! "Rank must be between 0 and 15"
+ rank = 1
+ if (c_establish (a, rank, attr) .ne. 0) stop 12 ! OK
+ if (allocated (a)) deallocate (a)
+ if (c_establish (a, rank, attr) .ne. 0) Stop 13 ! OK the first time
+ if (c_establish (a, rank, attr) .ne. 10) Stop 14 ! "its base address must be NULL"
+ if (allocated (a)) deallocate (a)
+ attr = 1 ! establish an allocatable
+ if (c_establish (a, rank, attr) .ne. 7) Stop 15 ! "is for a nonallocatable entity"
+ end subroutine test_CFI_establish
+
+ subroutine test_CFI_contiguous
+ integer, allocatable :: a
+ if (c_contiguous (a) .ne. 2) stop 16 ! "Descriptor is already NULL"
+ allocate (a)
+ if (c_contiguous (a) .ne. 5) stop 17 ! "must describe an array"
+ end subroutine test_CFI_contiguous
+
+ subroutine test_CFI_section
+ real, allocatable, dimension (:) :: a
+ integer, dimension(15) :: lower, strides
+ integer :: i
+ real :: b
+ lower(1) = 10
+ strides(1) = 5
+ if (int (c_section (1, a, lower, strides)) .ne. 2) &
+ stop 18 ! "Base address of source must not be NULL"
+ allocate (a(100))
+ if (int (c_section (1, a, lower, strides)) .ne. 0) &
+ stop 19 ! OK
+ if (int (c_section (1, b, lower, strides)) .ne. 5) &
+ stop 20 ! "Source must describe an array"
+ strides(1) = 0
+ if (int (c_section (1, a, lower, strides)) .ne. 5) &
+ stop 21 ! "Rank of result must be equal to the rank of source"
+ strides(1) = 5
+ lower(1) = -1
+ if (int (c_section (1, a, lower, strides)) .ne. 12) &
+ stop 22 ! "Lower bounds must be within the bounds of the fortran array"
+ lower(1) = 100
+ if (int (c_section (1, a, lower, strides)) .ne. 12) &
+ stop 23 ! "Lower bounds must be within the bounds of the fortran array"
+ end subroutine test_CFI_section
+
+ subroutine test_CFI_select_part
+ type(t), allocatable, dimension(:) :: a
+ type(t) :: src
+ allocate (a(1), source = src)
+ if (c_select_part (a) .ne. 5) stop 24 ! "Source and result must have the same rank"
+ deallocate (a)
+ if (c_select_part (a) .ne. 2) stop 25 ! "source must not be NULL"
+ end subroutine test_CFI_select_part
+
+ subroutine test_CFI_setpointer
+ integer, dimension(2,2), target :: tgt1
+ integer, dimension(:,:), pointer :: src
+ type (t), dimension(2), target :: tgt2
+ type (t), dimension(:), pointer :: res
+ type (t), dimension(2, 2), target, save :: tgt3
+ type (t), dimension(:, :), pointer :: src1
+ integer, dimension(2) :: lbounds = [-1, -2]
+ src => tgt1
+ res => tgt2
+ if (c_setpointer (res, src, lbounds) .ne. 4) stop 26 ! "Element lengths"
+ src1 => tgt3
+ if (c_setpointer (res, src1, lbounds) .ne. 5) stop 27 ! "Ranks of result"
+ end subroutine test_CFI_setpointer
+ end
Index: gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 (revision 267421)
--- gcc/testsuite/gfortran.dg/bind_c_array_params_2.f90 (working copy)
***************
*** 5,11 ****
!
! Check that assumed-shape variables are correctly passed to BIND(C)
! as defined in TS 29913
! !
interface
subroutine test (xx) bind(C, name="myBindC")
type(*), dimension(:,:) :: xx
--- 5,11 ----
!
! Check that assumed-shape variables are correctly passed to BIND(C)
! as defined in TS 29913
! !
interface
subroutine test (xx) bind(C, name="myBindC")
type(*), dimension(:,:) :: xx
*************** end
*** 20,23 ****
! { dg-final { scan-assembler-times "myBindC,%r2" 1 { target { hppa*-*-* } } } }
! { dg-final { scan-assembler-times "call\tmyBindC" 1 { target { *-*-cygwin* } } } }
! { dg-final { scan-assembler-times "brasl\t%r\[0-9\]*,myBindC" 1 { target { s390*-*-* } } } }
! ! { dg-final { scan-tree-dump-times "test \\\(&parm\\." 1 "original" } }
--- 20,23 ----
! { dg-final { scan-assembler-times "myBindC,%r2" 1 { target { hppa*-*-* } } } }
! { dg-final { scan-assembler-times "call\tmyBindC" 1 { target { *-*-cygwin* } } } }
! { dg-final { scan-assembler-times "brasl\t%r\[0-9\]*,myBindC" 1 { target { s390*-*-* } } } }
! ! { dg-final { scan-tree-dump-times "cfi_desc_to_gfc_desc \\\(&parm\\." 1 "original" } }
Index: libgfortran/ISO_Fortran_binding.h
===================================================================
*** libgfortran/ISO_Fortran_binding.h (nonexistent)
--- libgfortran/ISO_Fortran_binding.h (working copy)
***************
*** 0 ****
--- 1,206 ----
+ /* Declarations for ISO Fortran binding.
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Daniel Celis Garza <celisdanieljr@gmail.com>
+
+ This file is part of the GNU Fortran runtime library (libgfortran).
+
+ Libgfortran is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgfortran is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+ #ifndef ISO_FORTRAN_BINDING_H
+ #define ISO_FORTRAN_BINDING_H
+
+ #ifdef __cplusplus
+ extern "C" {
+ #endif
+
+ #include <stddef.h> /* Standard ptrdiff_t tand size_t. */
+ #include <stdint.h> /* Integer types. */
+
+ /* Constants, defined as macros. */
+ #define CFI_VERSION 1
+ #define CFI_MAX_RANK 15
+
+ /* Attributes. */
+ #define CFI_attribute_pointer 0
+ #define CFI_attribute_allocatable 1
+ #define CFI_attribute_other 2
+
+ /* Error codes.
+ CFI_INVALID_STRIDE should be defined in the standard because they are useful to the implementation of the functions.
+ */
+ #define CFI_SUCCESS 0
+ #define CFI_FAILURE 1
+ #define CFI_ERROR_BASE_ADDR_NULL 2
+ #define CFI_ERROR_BASE_ADDR_NOT_NULL 3
+ #define CFI_INVALID_ELEM_LEN 4
+ #define CFI_INVALID_RANK 5
+ #define CFI_INVALID_TYPE 6
+ #define CFI_INVALID_ATTRIBUTE 7
+ #define CFI_INVALID_EXTENT 8
+ #define CFI_INVALID_STRIDE 9
+ #define CFI_INVALID_DESCRIPTOR 10
+ #define CFI_ERROR_MEM_ALLOCATION 11
+ #define CFI_ERROR_OUT_OF_BOUNDS 12
+
+ /* CFI type definitions. */
+ typedef ptrdiff_t CFI_index_t;
+ typedef int8_t CFI_rank_t;
+ typedef int8_t CFI_attribute_t;
+ typedef int16_t CFI_type_t;
+
+ /* CFI_dim_t. */
+ typedef struct CFI_dim_t
+ {
+ CFI_index_t lower_bound;
+ CFI_index_t extent;
+ CFI_index_t sm;
+ }
+ CFI_dim_t;
+
+ /* CFI_cdesc_t, C descriptors are cast to this structure as follows:
+ CFI_CDESC_T(CFI_MAX_RANK) foo;
+ CFI_cdesc_t * bar = (CFI_cdesc_t *) &foo;
+ */
+ typedef struct CFI_cdesc_t
+ {
+ void *base_addr;
+ size_t elem_len;
+ int version;
+ CFI_rank_t rank;
+ CFI_attribute_t attribute;
+ CFI_type_t type;
+ CFI_dim_t dim[];
+ }
+ CFI_cdesc_t;
+
+ /* CFI_CDESC_T with an explicit type. */
+ #define CFI_CDESC_TYPE_T(r, base_type) \
+ struct { \
+ base_type *base_addr; \
+ size_t elem_len; \
+ int version; \
+ CFI_rank_t rank; \
+ CFI_attribute_t attribute; \
+ CFI_type_t type; \
+ CFI_dim_t dim[r]; \
+ }
+ #define CFI_CDESC_T(r) CFI_CDESC_TYPE_T (r, void)
+
+ /* CFI function declarations. */
+ extern void *CFI_address (const CFI_cdesc_t *, const CFI_index_t []);
+ extern int CFI_allocate (CFI_cdesc_t *, const CFI_index_t [], const CFI_index_t [],
+ size_t);
+ extern int CFI_deallocate (CFI_cdesc_t *);
+ extern int CFI_establish (CFI_cdesc_t *, void *, CFI_attribute_t, CFI_type_t, size_t,
+ CFI_rank_t, const CFI_index_t []);
+ extern int CFI_is_contiguous (const CFI_cdesc_t *);
+ extern int CFI_section (CFI_cdesc_t *, const CFI_cdesc_t *, const CFI_index_t [],
+ const CFI_index_t [], const CFI_index_t []);
+ extern int CFI_select_part (CFI_cdesc_t *, const CFI_cdesc_t *, size_t, size_t);
+ extern int CFI_setpointer (CFI_cdesc_t *, CFI_cdesc_t *, const CFI_index_t []);
+
+ /* Types and kind numbers. Allows bitwise and to reveal the intrinsic type of a kind type. It also allows us to find the kind parameter by inverting the bit-shift equation.
+ CFI_type_kind_shift = 8
+ CFI_intrinsic_type = 0 0 0 0 0 0 0 0 0 0 1 0
+ CFI_type_kind = 0 0 0 0 0 0 0 0 1 0 0 0
+ CFI_type_example = CFI_intrinsic_type + (CFI_type_kind << CFI_type_kind_shift)
+ Defining the CFI_type_example.
+ CFI_type_kind = 0 0 0 0 0 0 0 0 1 0 0 0 << CFI_type_kind_shift
+ -------------------------
+ 1 0 0 0 0 0 0 0 0 0 0 0 +
+ CFI_intrinsic_type = 0 0 0 0 0 0 0 0 0 0 1 0
+ -------------------------
+ CFI_type_example = 1 0 0 0 0 0 0 0 0 0 1 0
+ Finding the intrinsic type with the logical mask.
+ CFI_type_example = 1 0 0 0 0 0 0 0 0 0 1 0 &
+ CFI_type_mask = 0 0 0 0 1 1 1 1 1 1 1 1
+ -------------------------
+ CFI_intrinsic_type = 0 0 0 0 0 0 0 0 0 0 1 0
+ Using the intrinsic type and kind shift to find the kind value of the type.
+ CFI_type_kind = (CFI_type_example - CFI_intrinsic_type) >> CFI_type_kind_shift
+ CFI_type_example = 1 0 0 0 0 0 0 0 0 0 1 0 -
+ CFI_intrinsic_type = 0 0 0 0 0 0 0 0 0 0 1 0
+ -------------------------
+ 1 0 0 0 0 0 0 0 0 0 0 0 >> CFI_type_kind_shift
+ -------------------------
+ CFI_type_kind = 0 0 0 0 0 0 0 0 1 0 0 0
+ */
+ #define CFI_type_mask 0xFF
+ #define CFI_type_kind_shift 8
+
+ /* Intrinsic types. Their kind number defines their storage size. */
+ #define CFI_type_Integer 1
+ #define CFI_type_Logical 2
+ #define CFI_type_Real 3
+ #define CFI_type_Complex 4
+ #define CFI_type_Character 5
+
+ /* Types with no kind. */
+ #define CFI_type_struct 6
+ #define CFI_type_cptr 7
+ #define CFI_type_cfunptr 8
+ #define CFI_type_other -1
+
+ /* Types with kind parameter.
+ The kind parameter represents the type's byte size. The exception is kind = 10, which has byte size of 64 but 80 bit precision. Complex variables are double the byte size of their real counterparts. The ucs4_char matches wchar_t if sizeof (wchar_t) == 4.
+ */
+ #define CFI_type_char (CFI_type_Character + (1 << CFI_type_kind_shift))
+ #define CFI_type_ucs4_char (CFI_type_Character + (4 << CFI_type_kind_shift))
+
+ /* C-Fortran Interoperability types. */
+ #define CFI_type_signed_char (CFI_type_Integer + (1 << CFI_type_kind_shift))
+ #define CFI_type_short (CFI_type_Integer + (2 << CFI_type_kind_shift))
+ #define CFI_type_int (CFI_type_Integer + (4 << CFI_type_kind_shift))
+ #define CFI_type_long (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_long_long (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_size_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_int8_t (CFI_type_Integer + (1 << CFI_type_kind_shift))
+ #define CFI_type_int16_t (CFI_type_Integer + (2 << CFI_type_kind_shift))
+ #define CFI_type_int32_t (CFI_type_Integer + (4 << CFI_type_kind_shift))
+ #define CFI_type_int64_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_int_least8_t (CFI_type_Integer + (1 << CFI_type_kind_shift))
+ #define CFI_type_int_least16_t (CFI_type_Integer + (2 << CFI_type_kind_shift))
+ #define CFI_type_int_least32_t (CFI_type_Integer + (4 << CFI_type_kind_shift))
+ #define CFI_type_int_least64_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_int_fast8_t (CFI_type_Integer + (1 << CFI_type_kind_shift))
+ #define CFI_type_int_fast16_t (CFI_type_Integer + (2 << CFI_type_kind_shift))
+ #define CFI_type_int_fast32_t (CFI_type_Integer + (4 << CFI_type_kind_shift))
+ #define CFI_type_int_fast64_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_intmax_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_intptr_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_ptrdiff_t (CFI_type_Integer + (8 << CFI_type_kind_shift))
+ #define CFI_type_int128_t (CFI_type_Integer + (16 << CFI_type_kind_shift))
+ #define CFI_type_int_least128_t (CFI_type_Integer + (16 << CFI_type_kind_shift))
+ #define CFI_type_int_fast128_t (CFI_type_Integer + (16 << CFI_type_kind_shift))
+ #define CFI_type_Bool (CFI_type_Logical + (1 << CFI_type_kind_shift))
+ #define CFI_type_float (CFI_type_Real + (4 << CFI_type_kind_shift))
+ #define CFI_type_double (CFI_type_Real + (8 << CFI_type_kind_shift))
+ #define CFI_type_long_double (CFI_type_Real + (10 << CFI_type_kind_shift))
+ #define CFI_type_float128 (CFI_type_Real + (16 << CFI_type_kind_shift))
+ #define CFI_type_float_Complex (CFI_type_Complex + (4 << CFI_type_kind_shift))
+ #define CFI_type_double_Complex (CFI_type_Complex + (8 << CFI_type_kind_shift))
+ #define CFI_type_long_double_Complex (CFI_type_Complex + (10 << CFI_type_kind_shift))
+ #define CFI_type_float128_Complex (CFI_type_Complex + (16 << CFI_type_kind_shift))
+
+ #ifdef __cplusplus
+ }
+ #endif
+
+ #endif /* ISO_FORTRAN_BINDING_H */
Index: libgfortran/Makefile.am
===================================================================
*** libgfortran/Makefile.am (revision 267421)
--- libgfortran/Makefile.am (working copy)
*************** version_arg =
*** 30,35 ****
--- 30,38 ----
version_dep =
endif
+ gfor_c_HEADERS = $(srcdir)/ISO_Fortran_binding.h
+ gfor_cdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)/include
+
LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \
$(lt_host_flags)
*************** $(srcdir)/generated/spread_c8.c \
*** 782,787 ****
--- 785,793 ----
$(srcdir)/generated/spread_c10.c \
$(srcdir)/generated/spread_c16.c
+ i_isobinding_c = \
+ $(srcdir)/runtime/ISO_Fortran_binding.c
+
m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
*************** gfor_built_src= $(i_all_c) $(i_any_c) $(
*** 809,815 ****
$(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c) $(i_maxvals_c) \
$(i_maxval0s_c) $(i_minval0s_c) $(i_maxval1s_c) $(i_minval1s_c) \
$(i_findloc0_c) $(i_findloc0s_c) $(i_findloc1_c) $(i_findloc1s_c) \
! $(i_findloc2s_c)
# Machine generated specifics
gfor_built_specific_src= \
--- 815,821 ----
$(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c) $(i_maxvals_c) \
$(i_maxval0s_c) $(i_minval0s_c) $(i_maxval1s_c) $(i_minval1s_c) \
$(i_findloc0_c) $(i_findloc0s_c) $(i_findloc1_c) $(i_findloc1s_c) \
! $(i_findloc2s_c) $(i_isobinding_c)
# Machine generated specifics
gfor_built_specific_src= \
Index: libgfortran/Makefile.in
===================================================================
*** libgfortran/Makefile.in (revision 267421)
--- libgfortran/Makefile.in (working copy)
*************** am__aclocal_m4_deps = $(top_srcdir)/../c
*** 179,185 ****
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \
! $(am__configure_deps)
am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
configure.lineno config.status.lineno
mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
--- 179,185 ----
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \
! $(am__configure_deps) $(gfor_c_HEADERS)
am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
configure.lineno config.status.lineno
mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
*************** am__uninstall_files_from_dir = { \
*** 215,221 ****
}
am__installdirs = "$(DESTDIR)$(cafexeclibdir)" \
"$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" \
! "$(DESTDIR)$(fincludedir)"
LTLIBRARIES = $(cafexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES)
libcaf_single_la_LIBADD =
am_libcaf_single_la_OBJECTS = single.lo
--- 215,221 ----
}
am__installdirs = "$(DESTDIR)$(cafexeclibdir)" \
"$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" \
! "$(DESTDIR)$(gfor_cdir)" "$(DESTDIR)$(fincludedir)"
LTLIBRARIES = $(cafexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES)
libcaf_single_la_LIBADD =
am_libcaf_single_la_OBJECTS = single.lo
*************** am__objects_49 = findloc1_i1.lo findloc1
*** 378,384 ****
findloc1_r16.lo findloc1_c4.lo findloc1_c8.lo findloc1_c16.lo
am__objects_50 = findloc1_s1.lo findloc1_s4.lo
am__objects_51 = findloc2_s1.lo findloc2_s4.lo
! am__objects_52 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \
$(am__objects_7) $(am__objects_8) $(am__objects_9) \
$(am__objects_10) $(am__objects_11) $(am__objects_12) \
$(am__objects_13) $(am__objects_14) $(am__objects_15) \
--- 378,385 ----
findloc1_r16.lo findloc1_c4.lo findloc1_c8.lo findloc1_c16.lo
am__objects_50 = findloc1_s1.lo findloc1_s4.lo
am__objects_51 = findloc2_s1.lo findloc2_s4.lo
! am__objects_52 = ISO_Fortran_binding.lo
! am__objects_53 = $(am__objects_4) $(am__objects_5) $(am__objects_6) \
$(am__objects_7) $(am__objects_8) $(am__objects_9) \
$(am__objects_10) $(am__objects_11) $(am__objects_12) \
$(am__objects_13) $(am__objects_14) $(am__objects_15) \
*************** am__objects_52 = $(am__objects_4) $(am__
*** 393,406 ****
$(am__objects_40) $(am__objects_41) $(am__objects_42) \
$(am__objects_43) $(am__objects_44) $(am__objects_45) \
$(am__objects_46) $(am__objects_47) $(am__objects_48) \
! $(am__objects_49) $(am__objects_50) $(am__objects_51)
! @LIBGFOR_MINIMAL_FALSE@am__objects_53 = close.lo file_pos.lo format.lo \
@LIBGFOR_MINIMAL_FALSE@ inquire.lo intrinsics.lo list_read.lo \
@LIBGFOR_MINIMAL_FALSE@ lock.lo open.lo read.lo transfer.lo \
@LIBGFOR_MINIMAL_FALSE@ transfer128.lo unit.lo unix.lo write.lo \
@LIBGFOR_MINIMAL_FALSE@ fbuf.lo async.lo
! am__objects_54 = size_from_kind.lo $(am__objects_53)
! @LIBGFOR_MINIMAL_FALSE@am__objects_55 = access.lo c99_functions.lo \
@LIBGFOR_MINIMAL_FALSE@ chdir.lo chmod.lo clock.lo cpu_time.lo \
@LIBGFOR_MINIMAL_FALSE@ ctime.lo date_and_time.lo dtime.lo \
@LIBGFOR_MINIMAL_FALSE@ env.lo etime.lo execute_command_line.lo \
--- 394,408 ----
$(am__objects_40) $(am__objects_41) $(am__objects_42) \
$(am__objects_43) $(am__objects_44) $(am__objects_45) \
$(am__objects_46) $(am__objects_47) $(am__objects_48) \
! $(am__objects_49) $(am__objects_50) $(am__objects_51) \
! $(am__objects_52)
! @LIBGFOR_MINIMAL_FALSE@am__objects_54 = close.lo file_pos.lo format.lo \
@LIBGFOR_MINIMAL_FALSE@ inquire.lo intrinsics.lo list_read.lo \
@LIBGFOR_MINIMAL_FALSE@ lock.lo open.lo read.lo transfer.lo \
@LIBGFOR_MINIMAL_FALSE@ transfer128.lo unit.lo unix.lo write.lo \
@LIBGFOR_MINIMAL_FALSE@ fbuf.lo async.lo
! am__objects_55 = size_from_kind.lo $(am__objects_54)
! @LIBGFOR_MINIMAL_FALSE@am__objects_56 = access.lo c99_functions.lo \
@LIBGFOR_MINIMAL_FALSE@ chdir.lo chmod.lo clock.lo cpu_time.lo \
@LIBGFOR_MINIMAL_FALSE@ ctime.lo date_and_time.lo dtime.lo \
@LIBGFOR_MINIMAL_FALSE@ env.lo etime.lo execute_command_line.lo \
*************** am__objects_54 = size_from_kind.lo $(am_
*** 410,428 ****
@LIBGFOR_MINIMAL_FALSE@ rename.lo stat.lo symlnk.lo \
@LIBGFOR_MINIMAL_FALSE@ system_clock.lo time.lo umask.lo \
@LIBGFOR_MINIMAL_FALSE@ unlink.lo
! @IEEE_SUPPORT_TRUE@am__objects_56 = ieee_helper.lo
! am__objects_57 = associated.lo abort.lo args.lo cshift0.lo eoshift0.lo \
eoshift2.lo erfc_scaled.lo extends_type_of.lo fnum.lo \
ierrno.lo ishftc.lo mvbits.lo move_alloc.lo pack_generic.lo \
selected_char_kind.lo size.lo spread_generic.lo \
string_intrinsics.lo rand.lo random.lo reshape_generic.lo \
reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \
unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \
! $(am__objects_55) $(am__objects_56)
! @IEEE_SUPPORT_TRUE@am__objects_58 = ieee_arithmetic.lo \
@IEEE_SUPPORT_TRUE@ ieee_exceptions.lo ieee_features.lo
! am__objects_59 =
! am__objects_60 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
_abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \
_aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \
--- 412,430 ----
@LIBGFOR_MINIMAL_FALSE@ rename.lo stat.lo symlnk.lo \
@LIBGFOR_MINIMAL_FALSE@ system_clock.lo time.lo umask.lo \
@LIBGFOR_MINIMAL_FALSE@ unlink.lo
! @IEEE_SUPPORT_TRUE@am__objects_57 = ieee_helper.lo
! am__objects_58 = associated.lo abort.lo args.lo cshift0.lo eoshift0.lo \
eoshift2.lo erfc_scaled.lo extends_type_of.lo fnum.lo \
ierrno.lo ishftc.lo mvbits.lo move_alloc.lo pack_generic.lo \
selected_char_kind.lo size.lo spread_generic.lo \
string_intrinsics.lo rand.lo random.lo reshape_generic.lo \
reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \
unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \
! $(am__objects_56) $(am__objects_57)
! @IEEE_SUPPORT_TRUE@am__objects_59 = ieee_arithmetic.lo \
@IEEE_SUPPORT_TRUE@ ieee_exceptions.lo ieee_features.lo
! am__objects_60 =
! am__objects_61 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
_abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \
_aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \
*************** am__objects_60 = _abs_c4.lo _abs_c8.lo _
*** 446,464 ****
_conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
_aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
_anint_r8.lo _anint_r10.lo _anint_r16.lo
! am__objects_61 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
_sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \
_dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \
_atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \
_mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \
_mod_r10.lo _mod_r16.lo
! am__objects_62 = misc_specifics.lo
! am__objects_63 = $(am__objects_60) $(am__objects_61) $(am__objects_62) \
dprod_r8.lo f2c_specifics.lo random_init.lo
! am__objects_64 = $(am__objects_3) $(am__objects_52) $(am__objects_54) \
! $(am__objects_57) $(am__objects_58) $(am__objects_59) \
! $(am__objects_63)
! @onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_64)
@onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo
libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
AM_V_P = $(am__v_P_@AM_V@)
--- 448,466 ----
_conjg_c4.lo _conjg_c8.lo _conjg_c10.lo _conjg_c16.lo \
_aint_r4.lo _aint_r8.lo _aint_r10.lo _aint_r16.lo _anint_r4.lo \
_anint_r8.lo _anint_r10.lo _anint_r16.lo
! am__objects_62 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \
_sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \
_dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \
_atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \
_mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \
_mod_r10.lo _mod_r16.lo
! am__objects_63 = misc_specifics.lo
! am__objects_64 = $(am__objects_61) $(am__objects_62) $(am__objects_63) \
dprod_r8.lo f2c_specifics.lo random_init.lo
! am__objects_65 = $(am__objects_3) $(am__objects_53) $(am__objects_55) \
! $(am__objects_58) $(am__objects_59) $(am__objects_60) \
! $(am__objects_64)
! @onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_65)
@onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo
libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS)
AM_V_P = $(am__v_P_@AM_V@)
*************** am__can_run_installinfo = \
*** 531,537 ****
*) (install-info --version) >/dev/null 2>&1;; \
esac
DATA = $(toolexeclib_DATA)
! HEADERS = $(nodist_finclude_HEADERS)
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \
$(LISP)config.h.in
# Read a list of newline-separated strings from the standard input,
--- 533,539 ----
*) (install-info --version) >/dev/null 2>&1;; \
esac
DATA = $(toolexeclib_DATA)
! HEADERS = $(gfor_c_HEADERS) $(nodist_finclude_HEADERS)
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \
$(LISP)config.h.in
# Read a list of newline-separated strings from the standard input,
*************** pdfdir = @pdfdir@
*** 690,696 ****
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
- runstatedir = @runstatedir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
--- 692,697 ----
*************** gcc_version := $(shell @get_gcc_base_ver
*** 715,720 ****
--- 716,723 ----
@LIBGFOR_USE_SYMVER_FALSE@version_dep =
@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = $(srcdir)/gfortran.map
@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.map-sun
+ gfor_c_HEADERS = $(srcdir)/ISO_Fortran_binding.h
+ gfor_cdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)/include
LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \
$(lt_host_flags)
*************** $(srcdir)/generated/spread_c8.c \
*** 1340,1345 ****
--- 1343,1351 ----
$(srcdir)/generated/spread_c10.c \
$(srcdir)/generated/spread_c16.c
+ i_isobinding_c = \
+ $(srcdir)/runtime/ISO_Fortran_binding.c
+
m4_files = m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/all.m4 \
m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
*************** gfor_built_src = $(i_all_c) $(i_any_c) $
*** 1367,1373 ****
$(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c) $(i_maxvals_c) \
$(i_maxval0s_c) $(i_minval0s_c) $(i_maxval1s_c) $(i_minval1s_c) \
$(i_findloc0_c) $(i_findloc0s_c) $(i_findloc1_c) $(i_findloc1s_c) \
! $(i_findloc2s_c)
# Machine generated specifics
--- 1373,1379 ----
$(i_minloc1s_c) $(i_maxloc2s_c) $(i_minloc2s_c) $(i_maxvals_c) \
$(i_maxval0s_c) $(i_minval0s_c) $(i_maxval1s_c) $(i_minval1s_c) \
$(i_findloc0_c) $(i_findloc0s_c) $(i_findloc1_c) $(i_findloc1s_c) \
! $(i_findloc2s_c) $(i_isobinding_c)
# Machine generated specifics
*************** mostlyclean-compile:
*** 1697,1702 ****
--- 1703,1709 ----
distclean-compile:
-rm -f *.tab.c
+ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ISO_Fortran_binding.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/abort.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/access.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l1.Plo@am__quote@
*************** findloc2_s4.lo: $(srcdir)/generated/find
*** 6087,6092 ****
--- 6094,6106 ----
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o findloc2_s4.lo `test -f '$(srcdir)/generated/findloc2_s4.c' || echo '$(srcdir)/'`$(srcdir)/generated/findloc2_s4.c
+ ISO_Fortran_binding.lo: $(srcdir)/runtime/ISO_Fortran_binding.c
+ @am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT ISO_Fortran_binding.lo -MD -MP -MF $(DEPDIR)/ISO_Fortran_binding.Tpo -c -o ISO_Fortran_binding.lo `test -f '$(srcdir)/runtime/ISO_Fortran_binding.c' || echo '$(srcdir)/'`$(srcdir)/runtime/ISO_Fortran_binding.c
+ @am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/ISO_Fortran_binding.Tpo $(DEPDIR)/ISO_Fortran_binding.Plo
+ @AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$(srcdir)/runtime/ISO_Fortran_binding.c' object='ISO_Fortran_binding.lo' libtool=yes @AMDEPBACKSLASH@
+ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ @am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ISO_Fortran_binding.lo `test -f '$(srcdir)/runtime/ISO_Fortran_binding.c' || echo '$(srcdir)/'`$(srcdir)/runtime/ISO_Fortran_binding.c
+
size_from_kind.lo: io/size_from_kind.c
@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT size_from_kind.lo -MD -MP -MF $(DEPDIR)/size_from_kind.Tpo -c -o size_from_kind.lo `test -f 'io/size_from_kind.c' || echo '$(srcdir)/'`io/size_from_kind.c
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/size_from_kind.Tpo $(DEPDIR)/size_from_kind.Plo
*************** uninstall-toolexeclibDATA:
*** 6655,6660 ****
--- 6669,6695 ----
@list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
dir='$(DESTDIR)$(toolexeclibdir)'; $(am__uninstall_files_from_dir)
+ install-gfor_cHEADERS: $(gfor_c_HEADERS)
+ @$(NORMAL_INSTALL)
+ @list='$(gfor_c_HEADERS)'; test -n "$(gfor_cdir)" || list=; \
+ if test -n "$$list"; then \
+ echo " $(MKDIR_P) '$(DESTDIR)$(gfor_cdir)'"; \
+ $(MKDIR_P) "$(DESTDIR)$(gfor_cdir)" || exit 1; \
+ fi; \
+ for p in $$list; do \
+ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+ echo "$$d$$p"; \
+ done | $(am__base_list) | \
+ while read files; do \
+ echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(gfor_cdir)'"; \
+ $(INSTALL_HEADER) $$files "$(DESTDIR)$(gfor_cdir)" || exit $$?; \
+ done
+
+ uninstall-gfor_cHEADERS:
+ @$(NORMAL_UNINSTALL)
+ @list='$(gfor_c_HEADERS)'; test -n "$(gfor_cdir)" || list=; \
+ files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
+ dir='$(DESTDIR)$(gfor_cdir)'; $(am__uninstall_files_from_dir)
install-nodist_fincludeHEADERS: $(nodist_finclude_HEADERS)
@$(NORMAL_INSTALL)
@list='$(nodist_finclude_HEADERS)'; test -n "$(fincludedir)" || list=; \
*************** check: $(BUILT_SOURCES)
*** 6740,6746 ****
$(MAKE) $(AM_MAKEFLAGS) check-am
all-am: Makefile $(LTLIBRARIES) $(DATA) $(HEADERS) config.h all-local
installdirs:
! for dir in "$(DESTDIR)$(cafexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(fincludedir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: $(BUILT_SOURCES)
--- 6775,6781 ----
$(MAKE) $(AM_MAKEFLAGS) check-am
all-am: Makefile $(LTLIBRARIES) $(DATA) $(HEADERS) config.h all-local
installdirs:
! for dir in "$(DESTDIR)$(cafexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(gfor_cdir)" "$(DESTDIR)$(fincludedir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: $(BUILT_SOURCES)
*************** info: info-am
*** 6799,6805 ****
info-am:
! install-data-am: install-nodist_fincludeHEADERS
install-dvi: install-dvi-am
--- 6834,6840 ----
info-am:
! install-data-am: install-gfor_cHEADERS install-nodist_fincludeHEADERS
install-dvi: install-dvi-am
*************** ps: ps-am
*** 6849,6855 ****
ps-am:
! uninstall-am: uninstall-cafexeclibLTLIBRARIES \
uninstall-nodist_fincludeHEADERS uninstall-toolexeclibDATA \
uninstall-toolexeclibLTLIBRARIES
--- 6884,6890 ----
ps-am:
! uninstall-am: uninstall-cafexeclibLTLIBRARIES uninstall-gfor_cHEADERS \
uninstall-nodist_fincludeHEADERS uninstall-toolexeclibDATA \
uninstall-toolexeclibLTLIBRARIES
*************** uninstall-am: uninstall-cafexeclibLTLIBR
*** 6864,6879 ****
dvi dvi-am html html-am info info-am install install-am \
install-cafexeclibLTLIBRARIES install-data install-data-am \
install-dvi install-dvi-am install-exec install-exec-am \
! install-exec-local install-html install-html-am install-info \
! install-info-am install-man install-nodist_fincludeHEADERS \
! install-pdf install-pdf-am install-ps install-ps-am \
! install-strip install-toolexeclibDATA \
install-toolexeclibLTLIBRARIES installcheck installcheck-am \
installdirs maintainer-clean maintainer-clean-generic \
maintainer-clean-local mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool mostlyclean-local pdf \
pdf-am ps ps-am tags tags-am uninstall uninstall-am \
! uninstall-cafexeclibLTLIBRARIES \
uninstall-nodist_fincludeHEADERS uninstall-toolexeclibDATA \
uninstall-toolexeclibLTLIBRARIES
--- 6899,6914 ----
dvi dvi-am html html-am info info-am install install-am \
install-cafexeclibLTLIBRARIES install-data install-data-am \
install-dvi install-dvi-am install-exec install-exec-am \
! install-exec-local install-gfor_cHEADERS install-html \
! install-html-am install-info install-info-am install-man \
! install-nodist_fincludeHEADERS install-pdf install-pdf-am \
! install-ps install-ps-am install-strip install-toolexeclibDATA \
install-toolexeclibLTLIBRARIES installcheck installcheck-am \
installdirs maintainer-clean maintainer-clean-generic \
maintainer-clean-local mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool mostlyclean-local pdf \
pdf-am ps ps-am tags tags-am uninstall uninstall-am \
! uninstall-cafexeclibLTLIBRARIES uninstall-gfor_cHEADERS \
uninstall-nodist_fincludeHEADERS uninstall-toolexeclibDATA \
uninstall-toolexeclibLTLIBRARIES
Index: libgfortran/configure
===================================================================
*** libgfortran/configure (revision 267421)
--- libgfortran/configure (working copy)
*************** infodir
*** 780,786 ****
docdir
oldincludedir
includedir
- runstatedir
localstatedir
sharedstatedir
sysconfdir
--- 780,785 ----
*************** datadir='${datarootdir}'
*** 871,877 ****
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
- runstatedir='${localstatedir}/run'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
--- 870,875 ----
*************** do
*** 1124,1138 ****
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
- -runstatedir | --runstatedir | --runstatedi | --runstated \
- | --runstate | --runstat | --runsta | --runst | --runs \
- | --run | --ru | --r)
- ac_prev=runstatedir ;;
- -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
- | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
- | --run=* | --ru=* | --r=*)
- runstatedir=$ac_optarg ;;
-
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
--- 1122,1127 ----
*************** fi
*** 1270,1276 ****
for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
datadir sysconfdir sharedstatedir localstatedir includedir \
oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
! libdir localedir mandir runstatedir
do
eval ac_val=\$$ac_var
# Remove trailing slashes.
--- 1259,1265 ----
for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
datadir sysconfdir sharedstatedir localstatedir includedir \
oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
! libdir localedir mandir
do
eval ac_val=\$$ac_var
# Remove trailing slashes.
*************** Fine tuning of the installation director
*** 1423,1429 ****
--sysconfdir=DIR read-only single-machine data [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
--localstatedir=DIR modifiable single-machine data [PREFIX/var]
- --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run]
--libdir=DIR object code libraries [EPREFIX/lib]
--includedir=DIR C header files [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc [/usr/include]
--- 1412,1417 ----
*************** else
*** 12696,12702 ****
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
! #line 12699 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
--- 12684,12690 ----
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
! #line 12687 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
*************** else
*** 12802,12808 ****
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
! #line 12805 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
--- 12790,12796 ----
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
! #line 12793 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
*************** else
*** 16051,16057 ****
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
--- 16039,16045 ----
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
*************** else
*** 16097,16103 ****
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
--- 16085,16091 ----
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
*************** rm -f core conftest.err conftest.$ac_obj
*** 16121,16127 ****
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
--- 16109,16115 ----
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
*************** else
*** 16166,16172 ****
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
--- 16154,16160 ----
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
*************** rm -f core conftest.err conftest.$ac_obj
*** 16190,16196 ****
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
--- 16178,16184 ----
We can't simply define LARGE_OFF_T to be 9223372036854775807,
since some C++ compilers masquerading as C compilers
incorrectly reject 9223372036854775807. */
! #define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
&& LARGE_OFF_T % 2147483647 == 1)
? 1 : -1];
Index: libgfortran/gfortran.map
===================================================================
*** libgfortran/gfortran.map (revision 267421)
--- libgfortran/gfortran.map (working copy)
*************** GFORTRAN_C99_8 {
*** 1486,1491 ****
--- 1486,1501 ----
GFORTRAN_9 {
global:
+ CFI_address;
+ CFI_allocate;
+ CFI_deallocate;
+ CFI_establish;
+ CFI_is_contiguous;
+ CFI_section;
+ CFI_select_part;
+ CFI_setpointer;
+ _gfortran_gfc_desc_to_cfi_desc;
+ _gfortran_cfi_desc_to_gfc_desc;
_gfortran_findloc0_c16;
_gfortran_findloc0_c4;
_gfortran_findloc0_c8;
Index: libgfortran/runtime/ISO_Fortran_binding.c
===================================================================
*** libgfortran/runtime/ISO_Fortran_binding.c (nonexistent)
--- libgfortran/runtime/ISO_Fortran_binding.c (working copy)
***************
*** 0 ****
--- 1,864 ----
+ /* Functions to convert descriptors between CFI and gfortran
+ and the CFI function declarations whose prototypes appear
+ in ISO_Fortran_binding.h.
+ Copyright (C) 2018 Free Software Foundation, Inc.
+ Contributed by Daniel Celis Garza <celisdanieljr@gmail.com>
+ and Paul Thomas <pault@gcc.gnu.org>
+
+ This file is part of the GNU Fortran runtime library (libgfortran).
+
+ Libgfortran is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ Libgfortran is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+ #include "libgfortran.h"
+ #include <ISO_Fortran_binding.h>
+ #include <string.h>
+
+ extern void cfi_desc_to_gfc_desc (gfc_array_void *, CFI_cdesc_t **);
+ export_proto(cfi_desc_to_gfc_desc);
+
+ void
+ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr)
+ {
+ int n;
+ CFI_cdesc_t *s = *s_ptr;
+
+ /* If not a full pointer or allocatable array free the descriptor
+ and return. */
+ if (!s || s->attribute == CFI_attribute_other)
+ goto finish;
+
+ GFC_DESCRIPTOR_DATA (d) = s->base_addr;
+
+ if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len)
+ GFC_DESCRIPTOR_SIZE (d) = s->elem_len;
+ else
+ GFC_DESCRIPTOR_SIZE (d) = (index_type)s->dim[0].sm;
+
+ d->dtype.version = s->version;
+ GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank;
+ GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask);
+
+ /* Correct the unfortunate difference in order with types. */
+ if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER)
+ GFC_DESCRIPTOR_TYPE (d) = BT_DERIVED;
+ else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED)
+ GFC_DESCRIPTOR_TYPE (d) = BT_DERIVED;
+
+ d->dtype.attribute = (signed short)s->attribute;
+
+ if (s->rank)
+ d->span = (index_type)s->dim[0].sm;
+
+ /* On the other hand, CFI_establish can change the bounds. */
+ d->offset = 0;
+ for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++)
+ {
+ GFC_DESCRIPTOR_LBOUND(d, n) = (index_type)s->dim[n].lower_bound;
+ GFC_DESCRIPTOR_UBOUND(d, n) = (index_type)(s->dim[n].extent
+ + s->dim[n].lower_bound - 1);
+ GFC_DESCRIPTOR_STRIDE(d, n) = (index_type)(s->dim[n].sm / s->elem_len);
+ d->offset -= GFC_DESCRIPTOR_STRIDE(d, n) * GFC_DESCRIPTOR_LBOUND(d, n);
+ }
+
+ finish:
+ if (s)
+ free (s);
+ s = NULL;
+ }
+
+ extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *);
+ export_proto(gfc_desc_to_cfi_desc);
+
+ void
+ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s)
+ {
+ int n;
+ CFI_cdesc_t *d;
+
+ /* Play it safe with allocation of the flexible array member 'dim'
+ by setting the length to CFI_MAX_RANK. This should not be necessary
+ but valgrind complains accesses after the allocated block. */
+ d = malloc (sizeof (CFI_cdesc_t)
+ + (CFI_type_t)(CFI_MAX_RANK * sizeof (CFI_dim_t)));
+
+ d->base_addr = GFC_DESCRIPTOR_DATA (s);
+ d->elem_len = GFC_DESCRIPTOR_SIZE (s);
+ d->version = s->dtype.version;
+ d->rank = (CFI_rank_t)GFC_DESCRIPTOR_RANK (s);
+ d->attribute = (CFI_attribute_t)s->dtype.attribute;
+
+ if (GFC_DESCRIPTOR_TYPE (s) == BT_CHARACTER)
+ d->type = CFI_type_struct;
+ else if (GFC_DESCRIPTOR_TYPE (s) == BT_DERIVED)
+ d->type = CFI_type_Character;
+ else
+ d->type = (CFI_type_t)GFC_DESCRIPTOR_TYPE (s);
+
+ d->type = (CFI_type_t)(d->type
+ + ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
+
+ /* Full pointer or allocatable arrays have zero lower_bound. */
+ for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
+ {
+ if (d->attribute == CFI_attribute_other)
+ d->dim[n].lower_bound = (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n);
+ else
+ d->dim[n].lower_bound = 0;
+
+ /* Assumed size arrays have gfc ubound == 0 and CFI extent = -1. */
+ if ((n == GFC_DESCRIPTOR_RANK (s) - 1)
+ && GFC_DESCRIPTOR_LBOUND(s, n) == 1
+ && GFC_DESCRIPTOR_UBOUND(s, n) == 0)
+ d->dim[n].extent = -1;
+ else
+ d->dim[n].extent = (CFI_index_t)GFC_DESCRIPTOR_UBOUND(s, n)
+ - (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n) + 1;
+ d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
+ }
+
+ *d_ptr = d;
+ }
+
+ void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
+ {
+ int i;
+ char *base_addr = (char *)dv->base_addr;
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ /* C Descriptor must not be NULL. */
+ if (dv == NULL)
+ {
+ fprintf (stderr, "CFI_address: C Descriptor is NULL.\n");
+ return NULL;
+ }
+
+ /* Base address of C Descriptor must not be NULL. */
+ if (dv->base_addr == NULL)
+ {
+ fprintf (stderr, "CFI_address: base address of C Descriptor "
+ "must not be NULL.\n");
+ return NULL;
+ }
+ }
+
+ /* Return base address if C descriptor is a scalar. */
+ if (dv->rank == 0)
+ return dv->base_addr;
+
+ /* Calculate the appropriate base address if dv is not a scalar. */
+ else
+ {
+ /* Base address is the C address of the element of the object
+ specified by subscripts. */
+ for (i = 0; i < dv->rank; i++)
+ {
+ if (unlikely (compile_options.bounds_check)
+ && ((dv->dim[i].extent != -1
+ && subscripts[i] >= dv->dim[i].extent)
+ || subscripts[i] < 0))
+ {
+ fprintf (stderr, "CFI_address: subscripts[%d], is out of "
+ "bounds. dv->dim[%d].extent = %d subscripts[%d] "
+ "= %d.\n", i, i, (int)dv->dim[i].extent, i,
+ (int)subscripts[i]);
+ return NULL;
+ }
+
+ base_addr = base_addr + (CFI_index_t)(subscripts[i] * dv->dim[i].sm);
+ }
+ }
+
+ return (void *)base_addr;
+ }
+
+
+ int
+ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
+ const CFI_index_t upper_bounds[], size_t elem_len)
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ /* C Descriptor must not be NULL. */
+ if (dv == NULL)
+ {
+ fprintf (stderr, "CFI_allocate: C Descriptor is NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ /* The C Descriptor must be for an allocatable or pointer object. */
+ if (dv->attribute == CFI_attribute_other)
+ {
+ fprintf (stderr, "CFI_allocate: The object of the C descriptor "
+ "must be a pointer or allocatable variable.\n");
+ return CFI_INVALID_ATTRIBUTE;
+ }
+
+ /* Base address of C Descriptor must be NULL. */
+ if (dv->base_addr != NULL)
+ {
+ fprintf (stderr, "CFI_allocate: Base address of C descriptor "
+ "must be NULL.\n");
+ return CFI_ERROR_BASE_ADDR_NOT_NULL;
+ }
+ }
+
+ /* If the type is a character, the descriptor's element length is replaced
+ * by the elem_len argument. */
+ if (dv->type == CFI_type_char || dv->type == CFI_type_ucs4_char ||
+ dv->type == CFI_type_signed_char)
+ dv->elem_len = elem_len;
+
+ /* Dimension information and calculating the array length. */
+ size_t arr_len = 1;
+
+ /* If rank is greater than 0, lower_bounds and upper_bounds are used. They're
+ * ignored otherwhise. */
+ if (dv->rank > 0)
+ {
+ if (unlikely (compile_options.bounds_check)
+ && (lower_bounds == NULL || upper_bounds == NULL))
+ {
+ fprintf (stderr, "CFI_allocate: If 0 < rank (= %d) upper_bounds[] "
+ "and lower_bounds[], must not be NULL.\n", dv->rank);
+ return CFI_INVALID_EXTENT;
+ }
+
+ for (int i = 0; i < dv->rank; i++)
+ {
+ dv->dim[i].lower_bound = lower_bounds[i];
+ dv->dim[i].extent = upper_bounds[i] - dv->dim[i].lower_bound + 1;
+ if (i == 0)
+ dv->dim[i].sm = dv->elem_len;
+ else
+ dv->dim[i].sm = dv->elem_len * dv->dim[i - 1].extent;
+ arr_len *= dv->dim[i].extent;
+ }
+ }
+
+ dv->base_addr = calloc (arr_len, dv->elem_len);
+ if (dv->base_addr == NULL)
+ {
+ fprintf (stderr, "CFI_allocate: Failure in memory allocation.\n");
+ return CFI_ERROR_MEM_ALLOCATION;
+ }
+
+ return CFI_SUCCESS;
+ }
+
+
+ int
+ CFI_deallocate (CFI_cdesc_t *dv)
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ /* C Descriptor must not be NULL */
+ if (dv == NULL)
+ {
+ fprintf (stderr, "CFI_deallocate: C Descriptor is NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ /* Base address must not be NULL. */
+ if (dv->base_addr == NULL)
+ {
+ fprintf (stderr, "CFI_deallocate: Base address is already NULL.\n");
+ return CFI_ERROR_BASE_ADDR_NULL;
+ }
+
+ /* C Descriptor must be for an allocatable or pointer variable. */
+ if (dv->attribute == CFI_attribute_other)
+ {
+ fprintf (stderr, "CFI_deallocate: C Descriptor must describe a "
+ "pointer or allocatable object.\n");
+ return CFI_INVALID_ATTRIBUTE;
+ }
+ }
+
+ /* Free and nullify memory. */
+ free (dv->base_addr);
+ dv->base_addr = NULL;
+
+ return CFI_SUCCESS;
+ }
+
+
+ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
+ CFI_type_t type, size_t elem_len, CFI_rank_t rank,
+ const CFI_index_t extents[])
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ /* C descriptor must not be NULL. */
+ if (dv == NULL)
+ {
+ fprintf (stderr, "CFI_establish: C descriptor is NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ /* Rank must be between 0 and CFI_MAX_RANK. */
+ if (rank < 0 || rank > CFI_MAX_RANK)
+ {
+ fprintf (stderr, "CFI_establish: Rank must be between 0 and %d, "
+ "0 < rank (0 !< %d).\n", CFI_MAX_RANK, (int)rank);
+ return CFI_INVALID_RANK;
+ }
+
+ /* C Descriptor must not be an allocated allocatable. */
+ if (dv->attribute == CFI_attribute_allocatable && dv->base_addr != NULL)
+ {
+ fprintf (stderr, "CFI_establish: If the C Descriptor represents an "
+ "allocatable variable (dv->attribute = %d), its base "
+ "address must be NULL (dv->base_addr = NULL).\n",
+ CFI_attribute_allocatable);
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ /* If base address is not NULL, the established C Descriptor is for a
+ nonallocatable entity. */
+ if (attribute == CFI_attribute_allocatable && base_addr != NULL)
+ {
+ fprintf (stderr, "CFI_establish: If base address is not NULL "
+ "(base_addr != NULL), the established C descriptor is "
+ "for a nonallocatable entity (attribute != %d).\n",
+ CFI_attribute_allocatable);
+ return CFI_INVALID_ATTRIBUTE;
+ }
+ }
+
+ dv->base_addr = base_addr;
+
+ if (type == CFI_type_char || type == CFI_type_ucs4_char ||
+ type == CFI_type_signed_char || type == CFI_type_struct ||
+ type == CFI_type_other)
+ dv->elem_len = elem_len;
+ else
+ {
+ /* base_type describes the intrinsic type with kind parameter. */
+ size_t base_type = type & CFI_type_mask;
+ /* base_type_size is the size in bytes of the variable as given by its
+ * kind parameter. */
+ size_t base_type_size = (type - base_type) >> CFI_type_kind_shift;
+ /* Kind types 10 have a size of 64 bytes. */
+ if (base_type_size == 10)
+ {
+ base_type_size = 64;
+ }
+ /* Complex numbers are twice the size of their real counterparts. */
+ if (base_type == CFI_type_Complex)
+ {
+ base_type_size *= 2;
+ }
+ dv->elem_len = base_type_size;
+ }
+
+ dv->version = CFI_VERSION;
+ dv->rank = rank;
+ dv->attribute = attribute;
+ dv->type = type;
+
+ /* Extents must not be NULL if rank is greater than zero and base_addr is not
+ * NULL */
+ if (rank > 0 && base_addr != NULL)
+ {
+ if (unlikely (compile_options.bounds_check) && extents == NULL)
+ {
+ fprintf (stderr, "CFI_establish: Extents must not be NULL "
+ "(extents != NULL) if rank (= %d) > 0 nd base address"
+ "is not NULL (base_addr != NULL).\n", (int)rank);
+ return CFI_INVALID_EXTENT;
+ }
+
+ for (int i = 0; i < rank; i++)
+ {
+ /* If the C Descriptor is for a pointer then the lower bounds of every
+ * dimension are set to zero. */
+ if (attribute == CFI_attribute_pointer)
+ dv->dim[i].lower_bound = 0;
+ else
+ dv->dim[i].lower_bound = 1;
+
+ dv->dim[i].extent = extents[i];
+ if (i == 0)
+ dv->dim[i].sm = dv->elem_len;
+ else
+ dv->dim[i].sm = (CFI_index_t)(dv->elem_len * extents[i - 1]);
+ }
+ }
+
+ return CFI_SUCCESS;
+ }
+
+
+ int CFI_is_contiguous (const CFI_cdesc_t *dv)
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ /* C descriptor must not be NULL. */
+ if (dv == NULL)
+ {
+ fprintf (stderr, "CFI_is_contiguous: C descriptor is NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ /* Base address must not be NULL. */
+ if (dv->base_addr == NULL)
+ {
+ fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
+ "is already NULL.\n");
+ return CFI_ERROR_BASE_ADDR_NULL;
+ }
+
+ /* Must be an array. */
+ if (dv->rank == 0)
+ {
+ fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
+ "array (0 < dv->rank = %d).\n", dv->rank);
+ return CFI_INVALID_RANK;
+ }
+ }
+
+ /* Assumed size arrays are always contiguous. */
+ if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
+ return CFI_SUCCESS;
+
+ /* If an array is not contiguous the memory stride is different to the element
+ * length. */
+ for (int i = 0; i < dv->rank; i++)
+ {
+ if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
+ continue;
+ else if (i > 0
+ && dv->dim[i].sm == (CFI_index_t)(dv->elem_len
+ * dv->dim[i - 1].extent))
+ continue;
+
+ return CFI_FAILURE;
+ }
+
+ /* Array sections are guaranteed to be contiguous by the previous test. */
+ return CFI_SUCCESS;
+ }
+
+
+ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
+ const CFI_index_t lower_bounds[],
+ const CFI_index_t upper_bounds[], const CFI_index_t strides[])
+ {
+ /* Dimension information. */
+ CFI_index_t lower[CFI_MAX_RANK];
+ CFI_index_t upper[CFI_MAX_RANK];
+ CFI_index_t stride[CFI_MAX_RANK];
+ int zero_count = 0;
+ bool assumed_size;
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ /* C Descriptors must not be NULL. */
+ if (source == NULL)
+ {
+ fprintf (stderr, "CFI_section: Source must not be NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ if (result == NULL)
+ {
+ fprintf (stderr, "CFI_section: Result must not be NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ /* Base address of source must not be NULL. */
+ if (source->base_addr == NULL)
+ {
+ fprintf (stderr, "CFI_section: Base address of source must "
+ "not be NULL.\n");
+ return CFI_ERROR_BASE_ADDR_NULL;
+ }
+
+ /* Result must not be an allocatable array. */
+ if (result->attribute == CFI_attribute_allocatable)
+ {
+ fprintf (stderr, "CFI_section: Result must not describe an "
+ "allocatable array.\n");
+ return CFI_INVALID_ATTRIBUTE;
+ }
+
+ /* Source must be some form of array (nonallocatable nonpointer array,
+ allocated allocatable array or an associated pointer array). */
+ if (source->rank <= 0)
+ {
+ fprintf (stderr, "CFI_section: Source must describe an array "
+ "(0 < source->rank, 0 !< %d).\n", source->rank);
+ return CFI_INVALID_RANK;
+ }
+
+ /* Element lengths of source and result must be equal. */
+ if (result->elem_len != source->elem_len)
+ {
+ fprintf (stderr, "CFI_section: The element lengths of "
+ "source (source->elem_len = %d) and result "
+ "(result->elem_len = %d) must be equal.\n",
+ (int)source->elem_len, (int)result->elem_len);
+ return CFI_INVALID_ELEM_LEN;
+ }
+
+ /* Types must be equal. */
+ if (result->type != source->type)
+ {
+ fprintf (stderr, "CFI_section: Types of source "
+ "(source->type = %d) and result (result->type = %d) "
+ "must be equal.\n", source->type, result->type);
+ return CFI_INVALID_TYPE;
+ }
+ }
+
+ /* Stride of zero in the i'th dimension means rank reduction in that
+ dimension. */
+ for (int i = 0; i < source->rank; i++)
+ {
+ if (strides[i] == 0)
+ zero_count++;
+ }
+
+ /* Rank of result must be equal the the rank of source minus the number of
+ * zeros in strides. */
+ if (unlikely (compile_options.bounds_check)
+ && result->rank != source->rank - zero_count)
+ {
+ fprintf (stderr, "CFI_section: Rank of result must be equal to the "
+ "rank of source minus the number of zeros in strides "
+ "(result->rank = source->rank - zero_count, %d != %d "
+ "- %d).\n", result->rank, source->rank, zero_count);
+ return CFI_INVALID_RANK;
+ }
+
+ /* Lower bounds. */
+ if (lower_bounds == NULL)
+ {
+ for (int i = 0; i < source->rank; i++)
+ lower[i] = source->dim[i].lower_bound;
+ }
+ else
+ {
+ for (int i = 0; i < source->rank; i++)
+ lower[i] = lower_bounds[i];
+ }
+
+ /* Upper bounds. */
+ if (upper_bounds == NULL)
+ {
+ if (unlikely (compile_options.bounds_check)
+ && source->dim[source->rank - 1].extent == -1)
+ {
+ fprintf (stderr, "CFI_section: Source must not be an assumed size "
+ "array if upper_bounds is NULL.\n");
+ return CFI_INVALID_EXTENT;
+ }
+
+ for (int i = 0; i < source->rank; i++)
+ upper[i] = source->dim[i].lower_bound + source->dim[i].extent - 1;
+ }
+ else
+ {
+ for (int i = 0; i < source->rank; i++)
+ upper[i] = upper_bounds[i];
+ }
+
+ /* Stride */
+ if (strides == NULL)
+ {
+ for (int i = 0; i < source->rank; i++)
+ stride[i] = 1;
+ }
+ else
+ {
+ for (int i = 0; i < source->rank; i++)
+ {
+ stride[i] = strides[i];
+ /* If stride[i] == 0 then lower[i] and upper[i] must be equal. */
+ if (unlikely (compile_options.bounds_check)
+ && stride[i] == 0 && lower[i] != upper[i])
+ {
+ fprintf (stderr, "CFI_section: If strides[%d] = 0, then the "
+ "lower bounds, lower_bounds[%d] = %d, and "
+ "upper_bounds[%d] = %d, must be equal.\n",
+ i, i, (int)lower_bounds[i], i, (int)upper_bounds[i]);
+ return CFI_ERROR_OUT_OF_BOUNDS;
+ }
+ }
+ }
+
+ /* Check that section upper and lower bounds are within the array bounds. */
+ for (int i = 0; i < source->rank; i++)
+ {
+ assumed_size = (i == source->rank - 1)
+ && (source->dim[i].extent == -1);
+ if (unlikely (compile_options.bounds_check)
+ && lower_bounds != NULL
+ && (lower[i] < source->dim[i].lower_bound ||
+ (!assumed_size && lower[i] > source->dim[i].lower_bound
+ + source->dim[i].extent - 1)))
+ {
+ fprintf (stderr, "CFI_section: Lower bounds must be within the "
+ "bounds of the fortran array (source->dim[%d].lower_bound "
+ "<= lower_bounds[%d] <= source->dim[%d].lower_bound "
+ "+ source->dim[%d].extent - 1, %d <= %d <= %d).\n",
+ i, i, i, i, (int)source->dim[i].lower_bound, (int)lower[i],
+ (int)(source->dim[i].lower_bound
+ + source->dim[i].extent - 1));
+ return CFI_ERROR_OUT_OF_BOUNDS;
+ }
+
+ if (unlikely (compile_options.bounds_check)
+ && upper_bounds != NULL
+ && (upper[i] < source->dim[i].lower_bound
+ || (!assumed_size
+ && upper[i] > source->dim[i].lower_bound
+ + source->dim[i].extent - 1)))
+ {
+ fprintf (stderr, "CFI_section: Upper bounds must be within the "
+ "bounds of the fortran array (source->dim[%d].lower_bound "
+ "<= upper_bounds[%d] <= source->dim[%d].lower_bound + "
+ "source->dim[%d].extent - 1, %d !<= %d !<= %d).\n",
+ i, i, i, i, (int)source->dim[i].lower_bound, (int)upper[i],
+ (int)(source->dim[i].lower_bound
+ + source->dim[i].extent - 1));
+ return CFI_ERROR_OUT_OF_BOUNDS;
+ }
+
+ if (unlikely (compile_options.bounds_check)
+ && upper[i] < lower[i] && stride[i] >= 0)
+ {
+ fprintf (stderr, "CFI_section: If the upper bound is smaller than "
+ "the lower bound for a given dimension (upper[%d] < "
+ "lower[%d], %d < %d), then he stride for said dimension"
+ "t must be negative (stride[%d] < 0, %d < 0).\n",
+ i, i, (int)upper[i], (int)lower[i], i, (int)stride[i]);
+ return CFI_INVALID_STRIDE;
+ }
+ }
+
+ /* Set the appropriate dimension information that gives us access to the
+ * data. */
+ int aux = 0;
+ for (int i = 0; i < source->rank; i++)
+ {
+ if (stride[i] == 0)
+ {
+ aux++;
+ /* Adjust 'lower' for the base address offset. */
+ lower[i] = lower[i] - source->dim[i].lower_bound;
+ continue;
+ }
+ int idx = i - aux;
+ result->dim[idx].lower_bound = lower[i];
+ result->dim[idx].extent = upper[i] - lower[i] + 1;
+ result->dim[idx].sm = stride[i] * source->dim[i].sm;
+ /* Adjust 'lower' for the base address offset. */
+ lower[idx] = lower[idx] - source->dim[i].lower_bound;
+ }
+
+ /* Set the base address. */
+ result->base_addr = CFI_address (source, lower);
+
+ return CFI_SUCCESS;
+ }
+
+
+ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source,
+ size_t displacement, size_t elem_len)
+ {
+ if (unlikely (compile_options.bounds_check))
+ {
+ /* C Descriptors must not be NULL. */
+ if (source == NULL)
+ {
+ fprintf (stderr, "CFI_select_part: Source must not be NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ if (result == NULL)
+ {
+ fprintf (stderr, "CFI_select_part: Result must not be NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ /* Attribute of result will be CFI_attribute_other or
+ CFI_attribute_pointer. */
+ if (result->attribute == CFI_attribute_allocatable)
+ {
+ fprintf (stderr, "CFI_select_part: Result must not describe an "
+ "allocatable object (result->attribute != %d).\n",
+ CFI_attribute_allocatable);
+ return CFI_INVALID_ATTRIBUTE;
+ }
+
+ /* Base address of source must not be NULL. */
+ if (source->base_addr == NULL)
+ {
+ fprintf (stderr, "CFI_select_part: Base address of source must "
+ "not be NULL.\n");
+ return CFI_ERROR_BASE_ADDR_NULL;
+ }
+
+ /* Source and result must have the same rank. */
+ if (source->rank != result->rank)
+ {
+ fprintf (stderr, "CFI_select_part: Source and result must have "
+ "the same rank (source->rank = %d, result->rank = %d).\n",
+ (int)source->rank, (int)result->rank);
+ return CFI_INVALID_RANK;
+ }
+
+ /* Nonallocatable nonpointer must not be an assumed size array. */
+ if (source->rank > 0 && source->dim[source->rank - 1].extent == -1)
+ {
+ fprintf (stderr, "CFI_select_part: Source must not describe an "
+ "assumed size array (source->dim[%d].extent != -1).\n",
+ source->rank - 1);
+ return CFI_INVALID_DESCRIPTOR;
+ }
+ }
+
+ /* Element length. */
+ if (result->type == CFI_type_char || result->type == CFI_type_ucs4_char ||
+ result->type == CFI_type_signed_char)
+ result->elem_len = elem_len;
+
+ if (unlikely (compile_options.bounds_check))
+ {
+ /* Ensure displacement is within the bounds of the element length
+ of source.*/
+ if (displacement > source->elem_len - 1)
+ {
+ fprintf (stderr, "CFI_select_part: Displacement must be within the "
+ "bounds of source (0 <= displacement <= source->elem_len "
+ "- 1, 0 <= %d <= %d).\n", (int)displacement,
+ (int)(source->elem_len - 1));
+ return CFI_ERROR_OUT_OF_BOUNDS;
+ }
+
+ /* Ensure displacement and element length of result are less than or
+ equal to the element length of source. */
+ if (displacement + result->elem_len > source->elem_len)
+ {
+ fprintf (stderr, "CFI_select_part: Displacement plus the element "
+ "length of result must be less than or equal to the "
+ "element length of source (displacement + result->elem_len "
+ "<= source->elem_len, %d + %d = %d <= %d).\n",
+ (int)displacement, (int)result->elem_len,
+ (int)(displacement + result->elem_len),
+ (int)source->elem_len);
+ return CFI_ERROR_OUT_OF_BOUNDS;
+ }
+ }
+
+ if (result->rank > 0)
+ {
+ for (int i = 0; i < result->rank; i++)
+ {
+ result->dim[i].lower_bound = source->dim[i].lower_bound;
+ result->dim[i].extent = source->dim[i].extent;
+ result->dim[i].sm = source->dim[i].sm;
+ }
+ }
+
+ result->base_addr = (char *) source->base_addr + displacement;
+ return CFI_SUCCESS;
+ }
+
+
+ int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source,
+ const CFI_index_t lower_bounds[])
+ {
+ /* Result must not be NULL. */
+ if (unlikely (compile_options.bounds_check) && result == NULL)
+ {
+ fprintf (stderr, "CFI_setpointer: Result is NULL.\n");
+ return CFI_INVALID_DESCRIPTOR;
+ }
+
+ /* If source is NULL, the result is a C Descriptor that describes a
+ * disassociated pointer. */
+ if (source == NULL)
+ {
+ result->base_addr = NULL;
+ result->version = CFI_VERSION;
+ result->attribute = CFI_attribute_pointer;
+ }
+ else
+ {
+ /* Check that element lengths, ranks and types of source and result are
+ * the same. */
+ if (unlikely (compile_options.bounds_check))
+ {
+ if (result->elem_len != source->elem_len)
+ {
+ fprintf (stderr, "CFI_setpointer: Element lengths of result "
+ "(result->elem_len = %d) and source (source->elem_len "
+ "= %d) must be the same.\n", (int)result->elem_len,
+ (int)source->elem_len);
+ return CFI_INVALID_ELEM_LEN;
+ }
+
+ if (result->rank != source->rank)
+ {
+ fprintf (stderr, "CFI_setpointer: Ranks of result (result->rank "
+ "= %d) and source (source->rank = %d) must be the same."
+ "\n", result->rank, source->rank);
+ return CFI_INVALID_RANK;
+ }
+
+ if (result->type != source->type)
+ {
+ fprintf (stderr, "CFI_setpointer: Types of result (result->type"
+ "= %d) and source (source->type = %d) must be the same."
+ "\n", result->type, source->type);
+ return CFI_INVALID_TYPE;
+ }
+ }
+
+ /* If the source is a disassociated pointer, the result must also describe
+ * a disassociated pointer. */
+ if (source->base_addr == NULL &&
+ source->attribute == CFI_attribute_pointer)
+ result->base_addr = NULL;
+ else
+ result->base_addr = source->base_addr;
+
+ /* Assign components to result. */
+ result->version = source->version;
+ result->attribute = source->attribute;
+
+ /* Dimension information. */
+ for (int i = 0; i < source->rank; i++)
+ {
+ if (lower_bounds != NULL)
+ result->dim[i].lower_bound = lower_bounds[i];
+ else
+ result->dim[i].lower_bound = source->dim[i].lower_bound;
+
+ result->dim[i].extent = source->dim[i].extent;
+ result->dim[i].sm = source->dim[i].sm;
+ }
+ }
+
+ return CFI_SUCCESS;
+ }
^ permalink raw reply [flat|nested] 16+ messages in thread* Re: ISO_Fortran_binding patch
2019-01-07 20:29 ISO_Fortran_binding patch Paul Richard Thomas
@ 2019-01-08 23:19 ` Thomas Koenig
2019-01-09 9:21 ` Paul Richard Thomas
2019-01-12 15:28 ` Paul Richard Thomas
0 siblings, 2 replies; 16+ messages in thread
From: Thomas Koenig @ 2019-01-08 23:19 UTC (permalink / raw)
To: Paul Richard Thomas, fortran, gcc-patches, Steve Kargl
Hi Paul,
> This is an updated version of the earlier patch. The main addition is
> a second testcase that checks the errors emitted by the CFI API
> functions.
I notice that the header file ISO_Fortran_binding.h is found twice
in the patch.
Is there any particular reason why you do not want to use
! { dg-additional-options "-I $srcdir/../../libgfortran" }
in the test cases, and have it only once in the source trees?
However, I have no real strong opinion on this matter, if you
want to keep it as submitted, it is also fine.
Therefore: OK for trunk, and thanks a lot for the patch!
Documentation we can add at a later date, I think.
Regards
Thomas
^ permalink raw reply [flat|nested] 16+ messages in thread* Re: ISO_Fortran_binding patch
2019-01-08 23:19 ` Thomas Koenig
@ 2019-01-09 9:21 ` Paul Richard Thomas
2019-01-09 20:08 ` Thomas Koenig
2019-01-12 15:28 ` Paul Richard Thomas
1 sibling, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2019-01-09 9:21 UTC (permalink / raw)
To: Thomas Koenig; +Cc: fortran, gcc-patches, Steve Kargl
Hi Thomas,
> Is there any particular reason why you do not want to use
>
> ! { dg-additional-options "-I $srcdir/../../libgfortran" }
>
> in the test cases, and have it only once in the source trees?
I will make it so. Thanks for the reminder.
>
> However, I have no real strong opinion on this matter, if you
> want to keep it as submitted, it is also fine.
Incidentally, we need to make sure that it is distributed in the
include directory. I have yet to figure out how to do that.
>
> Therefore: OK for trunk, and thanks a lot for the patch!
>
> Documentation we can add at a later date, I think.
I can work that up before committing the patch since I will not be in
a position to work on gfortran until Saturday.
In the longer term, I will take the descriptor conversion out of the
library and will write a CFI equivalent of gfc_conv_expr_descriptor.
However, I will await the inevitable bug reports before doing that :-)
Thanks
Paul
>
> Regards
>
> Thomas
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread* Re: ISO_Fortran_binding patch
2019-01-09 9:21 ` Paul Richard Thomas
@ 2019-01-09 20:08 ` Thomas Koenig
2019-01-09 20:37 ` Damian Rouson
2019-01-09 23:07 ` Paul Richard Thomas
0 siblings, 2 replies; 16+ messages in thread
From: Thomas Koenig @ 2019-01-09 20:08 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: fortran, gcc-patches, Steve Kargl
Hi Paul,
> Incidentally, we need to make sure that it is distributed in the
> include directory. I have yet to figure out how to do that.
It already does that, that was part of what I sent you :-)
It's the
+gfor_c_HEADERS = $(srcdir)/ISO_Fortran_binding.h
+gfor_cdir =
$(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)/include
+
part in Makefile.am which puts in the requisite magic into
Makefile.im.
Header files are then installed into
$PREFIX/lib64/gcc/x86_64-pc-linux-gnu/9.0.0/include/ISO_Fortran_binding.h
$PREFIX/lib64/gcc/x86_64-pc-linux-gnu/9.0.0/32/include/ISO_Fortran_binding.h
So, OK for trunk.
Thanks a lot for this! Looking at what we are currently
finishing, I think we will be quite close to F2008 conformance
when gcc 9 comes out, modulo a few bugs, of course.
Regards
Thomas
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-09 20:08 ` Thomas Koenig
@ 2019-01-09 20:37 ` Damian Rouson
2019-01-09 23:07 ` Paul Richard Thomas
1 sibling, 0 replies; 16+ messages in thread
From: Damian Rouson @ 2019-01-09 20:37 UTC (permalink / raw)
To: Thomas Koenig; +Cc: Paul Richard Thomas, fortran, gcc-patches, Steve Kargl
On Wed, Jan 9, 2019 at 3:08 PM Thomas Koenig <tkoenig@netcologne.de> wrote:
>
>
> Thanks a lot for this! Looking at what we are currently
> finishing, I think we will be quite close to F2008 conformance
> when gcc 9 comes out, modulo a few bugs, of course.
And because ISO_Fortran_binding.h is part of Fortran 2018, this patch moves
gfortran closer to 2018 conformance as well.
Damian
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-09 20:08 ` Thomas Koenig
2019-01-09 20:37 ` Damian Rouson
@ 2019-01-09 23:07 ` Paul Richard Thomas
1 sibling, 0 replies; 16+ messages in thread
From: Paul Richard Thomas @ 2019-01-09 23:07 UTC (permalink / raw)
To: Thomas Koenig; +Cc: fortran, gcc-patches, Steve Kargl
Hi Thomas,
Aaaah! Light bulb moment - I was looking in the $PREFIX/include directory.
For whatever reason, mine does not appear in lib64 but in lib. OK,
that will have to do for now because the patch is blocking my tree for
a number of other things. I'll fix Bernhard's nit and commit on
Saturday.
Thanks everybody.
Paul
On Wed, 9 Jan 2019 at 20:08, Thomas Koenig <tkoenig@netcologne.de> wrote:
>
> Hi Paul,
>
> > Incidentally, we need to make sure that it is distributed in the
> > include directory. I have yet to figure out how to do that.
>
> It already does that, that was part of what I sent you :-)
>
> It's the
>
> +gfor_c_HEADERS = $(srcdir)/ISO_Fortran_binding.h
> +gfor_cdir =
> $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)/include
> +
>
> part in Makefile.am which puts in the requisite magic into
> Makefile.im.
>
> Header files are then installed into
>
> $PREFIX/lib64/gcc/x86_64-pc-linux-gnu/9.0.0/include/ISO_Fortran_binding.h
> $PREFIX/lib64/gcc/x86_64-pc-linux-gnu/9.0.0/32/include/ISO_Fortran_binding.h
>
> So, OK for trunk.
>
> Thanks a lot for this! Looking at what we are currently
> finishing, I think we will be quite close to F2008 conformance
> when gcc 9 comes out, modulo a few bugs, of course.
>
> Regards
>
> Thomas
>
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-08 23:19 ` Thomas Koenig
2019-01-09 9:21 ` Paul Richard Thomas
@ 2019-01-12 15:28 ` Paul Richard Thomas
2019-01-12 17:10 ` Steve Kargl
1 sibling, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2019-01-12 15:28 UTC (permalink / raw)
To: Thomas Koenig; +Cc: fortran, gcc-patches, Steve Kargl
Hi Thomas,
Committed as revision 267881. I removed the duplicate include file and
added some documentation, as suggested.
Many thanks for all the help
Paul
On Tue, 8 Jan 2019 at 23:19, Thomas Koenig <tkoenig@netcologne.de> wrote:
>
> Hi Paul,
>
> > This is an updated version of the earlier patch. The main addition is
> > a second testcase that checks the errors emitted by the CFI API
> > functions.
>
> I notice that the header file ISO_Fortran_binding.h is found twice
> in the patch.
>
> Is there any particular reason why you do not want to use
>
> ! { dg-additional-options "-I $srcdir/../../libgfortran" }
>
> in the test cases, and have it only once in the source trees?
>
> However, I have no real strong opinion on this matter, if you
> want to keep it as submitted, it is also fine.
>
> Therefore: OK for trunk, and thanks a lot for the patch!
>
> Documentation we can add at a later date, I think.
>
> Regards
>
> Thomas
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread* Re: ISO_Fortran_binding patch
2019-01-12 15:28 ` Paul Richard Thomas
@ 2019-01-12 17:10 ` Steve Kargl
2019-01-12 17:17 ` Steve Kargl
0 siblings, 1 reply; 16+ messages in thread
From: Steve Kargl @ 2019-01-12 17:10 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: Thomas Koenig, fortran, gcc-patches
On Sat, Jan 12, 2019 at 03:28:02PM +0000, Paul Richard Thomas wrote:
> Hi Thomas,
>
> Committed as revision 267881. I removed the duplicate include file and
> added some documentation, as suggested.
>
> Many thanks for all the help
>
Paul,
I'm seeing the following failures. Note, I have my uncommitted
ENTRY patch in my tree. I won't be able to investigate for about
30 minutes.
FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O0 execution test
Running /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/debug/debug.exp ...
Running /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/dg.exp ...
FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O2 execution test
FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions execution test
FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O3 -g execution test
--
Steve
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-12 17:10 ` Steve Kargl
@ 2019-01-12 17:17 ` Steve Kargl
2019-01-12 18:29 ` Paul Richard Thomas
0 siblings, 1 reply; 16+ messages in thread
From: Steve Kargl @ 2019-01-12 17:17 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: Thomas Koenig, fortran, gcc-patches
On Sat, Jan 12, 2019 at 09:10:27AM -0800, Steve Kargl wrote:
> On Sat, Jan 12, 2019 at 03:28:02PM +0000, Paul Richard Thomas wrote:
> > Hi Thomas,
> >
> > Committed as revision 267881. I removed the duplicate include file and
> > added some documentation, as suggested.
> >
> > Many thanks for all the help
> >
>
> Paul,
>
> I'm seeing the following failures. Note, I have my uncommitted
> ENTRY patch in my tree. I won't be able to investigate for about
> 30 minutes.
>
> FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O0 execution test
> Running /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/debug/debug.exp ...
> Running /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/dg.exp ...
> FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O2 execution test
> FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions execution test
> FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O3 -g execution test
>
Regression testing finished faster than I thought. Doing
% gmake check-fortran RUNTESTFLAGS="dg.exp=ISO_Fortran_binding_2.f90"
...
=== gfortran Summary ===
# of expected passes 8
# of unexpected failures 4
The first failure in the gfortran.log file is
CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = 3.
CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = -1.
CFI_address: base address of C Descriptor must not be NULL.
CFI_deallocate: Base address is already NULL.
CFI_deallocate: C Descriptor must describe a pointer or allocatable object.
CFI_allocate: Base address of C descriptor must be NULL.
CFI_allocate: The object of the C descriptor must be a pointer or allocatable variable.
CFI_establish: Rank must be between 0 and 15, 0 < rank (0 !< 16).
CFI_establish: If the C Descriptor represents an allocatable variable (dv->attribute = 1), its base address must be NULL (dv->base_addr = NULL).
CFI_establish: If base address is not NULL (base_addr != NULL), the established C descriptor is for a nonallocatable entity (attribute != 1).
CFI_is_contiguous: Base address of C Descriptor is already NULL.
CFI_is_contiguous: C Descriptor must describe an array (0 < dv->rank = 0).
CFI_section: Base address of source must not be NULL.
CFI_section: Source must describe an array (0 < source->rank, 0 !< 0).
CFI_section: Rank of result must be equal to the rank of source minus the number of zeros in strides (result->rank = source->rank - zero_count, 1 != 1 - 1).
CFI_section: Lower bounds must be within the bounds of the fortran array (source->dim[0].lower_bound <= lower_bounds[0] <= source->dim[0].lower_bound + source->dim[0].extent - 1, 0 <= -1 <= 99).
CFI_section: Lower bounds must be within the bounds of the fortran array (source->dim[0].lower_bound <= lower_bo
unds[0] <= source->dim[0].lower_bound + source->dim[0].extent - 1, 0 <= 100 <= 99).
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7ffffffff1a2 in ???
#1 0x0 in ???
The 2nd, 3rd, and 4th failures are
CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = 3.
CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = -1.
CFI_address: base address of C Descriptor must not be NULL.
CFI_deallocate: Base address is already NULL.
Program received signal SIGFPE: Floating-point exception - erroneous arithmetic operation.
Backtrace for this error:
#0 0x7ffffffff1a2 in ???
#1 0x400eed in ???
#2 0x4021ea in _start
at /usr/src/lib/csu/amd64/crt1.c:76
#3 0x200628fff in ???
--
Steve
^ permalink raw reply [flat|nested] 16+ messages in thread* Re: ISO_Fortran_binding patch
2019-01-12 17:17 ` Steve Kargl
@ 2019-01-12 18:29 ` Paul Richard Thomas
2019-01-12 18:35 ` Paul Richard Thomas
0 siblings, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2019-01-12 18:29 UTC (permalink / raw)
To: Steve Kargl; +Cc: Thomas Koenig, fortran, gcc-patches
Hi Steve,
Many thanks for the heads up. I had seen similar problems with the the
second testcase and I thought that I had fixed them. I will delete
them from the tree and will do more work to fix the problem(s).
Cheers
Paul
On Sat, 12 Jan 2019 at 17:17, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> On Sat, Jan 12, 2019 at 09:10:27AM -0800, Steve Kargl wrote:
> > On Sat, Jan 12, 2019 at 03:28:02PM +0000, Paul Richard Thomas wrote:
> > > Hi Thomas,
> > >
> > > Committed as revision 267881. I removed the duplicate include file and
> > > added some documentation, as suggested.
> > >
> > > Many thanks for all the help
> > >
> >
> > Paul,
> >
> > I'm seeing the following failures. Note, I have my uncommitted
> > ENTRY patch in my tree. I won't be able to investigate for about
> > 30 minutes.
> >
> > FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O0 execution test
> > Running /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/debug/debug.exp ...
> > Running /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/dg.exp ...
> > FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O2 execution test
> > FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions execution test
> > FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O3 -g execution test
> >
>
> Regression testing finished faster than I thought. Doing
>
> % gmake check-fortran RUNTESTFLAGS="dg.exp=ISO_Fortran_binding_2.f90"
> ...
> === gfortran Summary ===
>
> # of expected passes 8
> # of unexpected failures 4
>
> The first failure in the gfortran.log file is
>
> CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = 3.
> CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = -1.
> CFI_address: base address of C Descriptor must not be NULL.
> CFI_deallocate: Base address is already NULL.
> CFI_deallocate: C Descriptor must describe a pointer or allocatable object.
> CFI_allocate: Base address of C descriptor must be NULL.
> CFI_allocate: The object of the C descriptor must be a pointer or allocatable variable.
> CFI_establish: Rank must be between 0 and 15, 0 < rank (0 !< 16).
> CFI_establish: If the C Descriptor represents an allocatable variable (dv->attribute = 1), its base address must be NULL (dv->base_addr = NULL).
> CFI_establish: If base address is not NULL (base_addr != NULL), the established C descriptor is for a nonallocatable entity (attribute != 1).
> CFI_is_contiguous: Base address of C Descriptor is already NULL.
> CFI_is_contiguous: C Descriptor must describe an array (0 < dv->rank = 0).
> CFI_section: Base address of source must not be NULL.
> CFI_section: Source must describe an array (0 < source->rank, 0 !< 0).
> CFI_section: Rank of result must be equal to the rank of source minus the number of zeros in strides (result->rank = source->rank - zero_count, 1 != 1 - 1).
> CFI_section: Lower bounds must be within the bounds of the fortran array (source->dim[0].lower_bound <= lower_bounds[0] <= source->dim[0].lower_bound + source->dim[0].extent - 1, 0 <= -1 <= 99).
> CFI_section: Lower bounds must be within the bounds of the fortran array (source->dim[0].lower_bound <= lower_bo
> unds[0] <= source->dim[0].lower_bound + source->dim[0].extent - 1, 0 <= 100 <= 99).
>
> Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
>
> Backtrace for this error:
> #0 0x7ffffffff1a2 in ???
> #1 0x0 in ???
>
> The 2nd, 3rd, and 4th failures are
>
> CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = 3.
> CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = -1.
> CFI_address: base address of C Descriptor must not be NULL.
> CFI_deallocate: Base address is already NULL.
>
> Program received signal SIGFPE: Floating-point exception - erroneous arithmetic operation.
>
> Backtrace for this error:
> #0 0x7ffffffff1a2 in ???
> #1 0x400eed in ???
> #2 0x4021ea in _start
> at /usr/src/lib/csu/amd64/crt1.c:76
> #3 0x200628fff in ???
>
>
> --
> Steve
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-12 18:29 ` Paul Richard Thomas
@ 2019-01-12 18:35 ` Paul Richard Thomas
2019-01-14 23:08 ` Jakub Jelinek
0 siblings, 1 reply; 16+ messages in thread
From: Paul Richard Thomas @ 2019-01-12 18:35 UTC (permalink / raw)
To: Steve Kargl; +Cc: Thomas Koenig, fortran, gcc-patches
Done as revision 267884.
Thanks again.
Paul
On Sat, 12 Jan 2019 at 18:29, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
>
> Hi Steve,
>
> Many thanks for the heads up. I had seen similar problems with the the
> second testcase and I thought that I had fixed them. I will delete
> them from the tree and will do more work to fix the problem(s).
>
> Cheers
>
> Paul
>
> On Sat, 12 Jan 2019 at 17:17, Steve Kargl
> <sgk@troutmask.apl.washington.edu> wrote:
> >
> > On Sat, Jan 12, 2019 at 09:10:27AM -0800, Steve Kargl wrote:
> > > On Sat, Jan 12, 2019 at 03:28:02PM +0000, Paul Richard Thomas wrote:
> > > > Hi Thomas,
> > > >
> > > > Committed as revision 267881. I removed the duplicate include file and
> > > > added some documentation, as suggested.
> > > >
> > > > Many thanks for all the help
> > > >
> > >
> > > Paul,
> > >
> > > I'm seeing the following failures. Note, I have my uncommitted
> > > ENTRY patch in my tree. I won't be able to investigate for about
> > > 30 minutes.
> > >
> > > FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O0 execution test
> > > Running /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/debug/debug.exp ...
> > > Running /safe/sgk/gcc/gccx/gcc/testsuite/gfortran.dg/dg.exp ...
> > > FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O2 execution test
> > > FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions execution test
> > > FAIL: gfortran.dg/ISO_Fortran_binding_2.f90 -O3 -g execution test
> > >
> >
> > Regression testing finished faster than I thought. Doing
> >
> > % gmake check-fortran RUNTESTFLAGS="dg.exp=ISO_Fortran_binding_2.f90"
> > ...
> > === gfortran Summary ===
> >
> > # of expected passes 8
> > # of unexpected failures 4
> >
> > The first failure in the gfortran.log file is
> >
> > CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = 3.
> > CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = -1.
> > CFI_address: base address of C Descriptor must not be NULL.
> > CFI_deallocate: Base address is already NULL.
> > CFI_deallocate: C Descriptor must describe a pointer or allocatable object.
> > CFI_allocate: Base address of C descriptor must be NULL.
> > CFI_allocate: The object of the C descriptor must be a pointer or allocatable variable.
> > CFI_establish: Rank must be between 0 and 15, 0 < rank (0 !< 16).
> > CFI_establish: If the C Descriptor represents an allocatable variable (dv->attribute = 1), its base address must be NULL (dv->base_addr = NULL).
> > CFI_establish: If base address is not NULL (base_addr != NULL), the established C descriptor is for a nonallocatable entity (attribute != 1).
> > CFI_is_contiguous: Base address of C Descriptor is already NULL.
> > CFI_is_contiguous: C Descriptor must describe an array (0 < dv->rank = 0).
> > CFI_section: Base address of source must not be NULL.
> > CFI_section: Source must describe an array (0 < source->rank, 0 !< 0).
> > CFI_section: Rank of result must be equal to the rank of source minus the number of zeros in strides (result->rank = source->rank - zero_count, 1 != 1 - 1).
> > CFI_section: Lower bounds must be within the bounds of the fortran array (source->dim[0].lower_bound <= lower_bounds[0] <= source->dim[0].lower_bound + source->dim[0].extent - 1, 0 <= -1 <= 99).
> > CFI_section: Lower bounds must be within the bounds of the fortran array (source->dim[0].lower_bound <= lower_bo
> > unds[0] <= source->dim[0].lower_bound + source->dim[0].extent - 1, 0 <= 100 <= 99).
> >
> > Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
> >
> > Backtrace for this error:
> > #0 0x7ffffffff1a2 in ???
> > #1 0x0 in ???
> >
> > The 2nd, 3rd, and 4th failures are
> >
> > CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = 3.
> > CFI_address: subscripts[0], is out of bounds. dv->dim[0].extent = 3 subscripts[0] = -1.
> > CFI_address: base address of C Descriptor must not be NULL.
> > CFI_deallocate: Base address is already NULL.
> >
> > Program received signal SIGFPE: Floating-point exception - erroneous arithmetic operation.
> >
> > Backtrace for this error:
> > #0 0x7ffffffff1a2 in ???
> > #1 0x400eed in ???
> > #2 0x4021ea in _start
> > at /usr/src/lib/csu/amd64/crt1.c:76
> > #3 0x200628fff in ???
> >
> >
> > --
> > Steve
>
>
>
> --
> "If you can't explain it simply, you don't understand it well enough"
> - Albert Einstein
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-12 18:35 ` Paul Richard Thomas
@ 2019-01-14 23:08 ` Jakub Jelinek
2019-01-15 0:08 ` Steve Kargl
2019-01-15 7:06 ` Richard Biener
0 siblings, 2 replies; 16+ messages in thread
From: Jakub Jelinek @ 2019-01-14 23:08 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: Steve Kargl, Thomas Koenig, fortran, gcc-patches
On Sat, Jan 12, 2019 at 06:35:20PM +0000, Paul Richard Thomas wrote:
> Done as revision 267884.
The other tests FAILs too:
FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O0 (test for excess errors)
UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O0 compilation failed to produce executable
FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O1 (test for excess errors)
UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O1 compilation failed to produce executable
FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O2 (test for excess errors)
UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O2 compilation failed to produce executable
FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions (test for excess errors)
UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions compilation failed to produce executable
FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O3 -g (test for excess errors)
UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O3 -g compilation failed to produce executable
FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -Os (test for excess errors)
UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -Os compilation failed to produce executable
The problem is that:
Excess errors:
/home/jakub/src/gcc/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c:3:10: fatal error: ISO_Fortran_binding.h: No such file or directory
compilation terminated.
It either should
#include "../../../libgfortran/ISO_Fortran_binding.h"
instead or the Fortran *.exp files should arrange for -I.../libgfortran/
to be added to all gfortran tests. Because right now it FAILs if you don't
have ISO_Fortran_binding.h header installed, or succeeds, but includes
header from some other compiler version or even other compiler altogether.
Where is that header installed BTW?
Would be best if it got installed in directories like:
$prefix/lib/gcc/$target/$version/include
See e.g. libssp or libsanitizer, both have something like
target_noncanonical = @target_noncanonical@
libsubincludedir = $(libdir)/gcc/$(target_noncanonical)/$(gcc_version)/include
nobase_libsubinclude_HEADERS = ssp/ssp.h ssp/string.h ssp/stdio.h ssp/unistd.h
You probably want it to go directly in the include dir, so without the ssp/
or whatever else prefixes.
Jakub
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-14 23:08 ` Jakub Jelinek
@ 2019-01-15 0:08 ` Steve Kargl
2019-01-15 7:06 ` Richard Biener
1 sibling, 0 replies; 16+ messages in thread
From: Steve Kargl @ 2019-01-15 0:08 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: Paul Richard Thomas, Thomas Koenig, fortran, gcc-patches
On Tue, Jan 15, 2019 at 12:07:53AM +0100, Jakub Jelinek wrote:
> On Sat, Jan 12, 2019 at 06:35:20PM +0000, Paul Richard Thomas wrote:
> > Done as revision 267884.
>
> Where is that header installed BTW?
> Would be best if it got installed in directories like:
> $prefix/lib/gcc/$target/$version/include
>
I have it in
${HOME}/work/x/lib/gcc/x86_64-unknown-freebsd13.0/9.0.0/include
where my $prefix is ${HOME}/work/x. So, this seems to match
your "best" suggestion.
--
Steve
^ permalink raw reply [flat|nested] 16+ messages in thread* Re: ISO_Fortran_binding patch
2019-01-14 23:08 ` Jakub Jelinek
2019-01-15 0:08 ` Steve Kargl
@ 2019-01-15 7:06 ` Richard Biener
2019-01-15 8:02 ` Jakub Jelinek
1 sibling, 1 reply; 16+ messages in thread
From: Richard Biener @ 2019-01-15 7:06 UTC (permalink / raw)
To: Jakub Jelinek, Paul Richard Thomas
Cc: Steve Kargl, Thomas Koenig, fortran, gcc-patches
On January 15, 2019 12:07:53 AM GMT+01:00, Jakub Jelinek <jakub@redhat.com> wrote:
>On Sat, Jan 12, 2019 at 06:35:20PM +0000, Paul Richard Thomas wrote:
>> Done as revision 267884.
>
>The other tests FAILs too:
>FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O0 (test for excess
>errors)
>UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O0 compilation
>failed to produce executable
>FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O1 (test for excess
>errors)
>UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O1 compilation
>failed to produce executable
>FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O2 (test for excess
>errors)
>UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O2 compilation
>failed to produce executable
>FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O3 -fomit-frame-pointer
>-funroll-loops -fpeel-loops -ftracer -finline-functions (test for
>excess errors)
>UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O3
>-fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer
>-finline-functions compilation failed to produce executable
>FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -O3 -g (test for excess
>errors)
>UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -O3 -g compilation
>failed to produce executable
>FAIL: gfortran.dg/ISO_Fortran_binding_1.f90 -Os (test for excess
>errors)
>UNRESOLVED: gfortran.dg/ISO_Fortran_binding_1.f90 -Os compilation
>failed to produce executable
>
>The problem is that:
>Excess errors:
>/home/jakub/src/gcc/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_1.c:3:10:
>fatal error: ISO_Fortran_binding.h: No such file or directory
>compilation terminated.
>
>It either should
>#include "../../../libgfortran/ISO_Fortran_binding.h"
>instead or the Fortran *.exp files should arrange for
>-I.../libgfortran/
>to be added to all gfortran tests. Because right now it FAILs if you
>don't
>have ISO_Fortran_binding.h header installed, or succeeds, but includes
>header from some other compiler version or even other compiler
>altogether.
>
>Where is that header installed BTW?
>Would be best if it got installed in directories like:
>$prefix/lib/gcc/$target/$version/include
>
>See e.g. libssp or libsanitizer, both have something like
>target_noncanonical = @target_noncanonical@
>libsubincludedir =
>$(libdir)/gcc/$(target_noncanonical)/$(gcc_version)/include
>nobase_libsubinclude_HEADERS = ssp/ssp.h ssp/string.h ssp/stdio.h
>ssp/unistd.h
>
>You probably want it to go directly in the include dir, so without the
>ssp/
>or whatever else prefixes.
It's there, but also in the multilib locations (which is dubious? Not sure if we ever search tose include paths)
Richard.
>
> Jakub
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-15 7:06 ` Richard Biener
@ 2019-01-15 8:02 ` Jakub Jelinek
2019-01-15 19:58 ` Paul Richard Thomas
0 siblings, 1 reply; 16+ messages in thread
From: Jakub Jelinek @ 2019-01-15 8:02 UTC (permalink / raw)
To: Richard Biener
Cc: Paul Richard Thomas, Steve Kargl, Thomas Koenig, fortran, gcc-patches
On Tue, Jan 15, 2019 at 08:05:59AM +0100, Richard Biener wrote:
> >It either should
> >#include "../../../libgfortran/ISO_Fortran_binding.h"
> >instead or the Fortran *.exp files should arrange for
> >-I.../libgfortran/
> >to be added to all gfortran tests. Because right now it FAILs if you
> >don't
> >have ISO_Fortran_binding.h header installed, or succeeds, but includes
> >header from some other compiler version or even other compiler
> >altogether.
This still needs to be fixed.
> >Where is that header installed BTW?
> >Would be best if it got installed in directories like:
> >$prefix/lib/gcc/$target/$version/include
> >
> >See e.g. libssp or libsanitizer, both have something like
> >target_noncanonical = @target_noncanonical@
> >libsubincludedir =
> >$(libdir)/gcc/$(target_noncanonical)/$(gcc_version)/include
> >nobase_libsubinclude_HEADERS = ssp/ssp.h ssp/string.h ssp/stdio.h
> >ssp/unistd.h
> >
> >You probably want it to go directly in the include dir, so without the
> >ssp/
> >or whatever else prefixes.
>
> It's there, but also in the multilib locations (which is dubious? Not sure if we ever search tose include paths)
Yeah, for -m32 it is in
.../lib/gcc/x86_64-pc-linux-gnu/9.0.0/32/include/
which isn't that useful; while the finclude/ in there is needed, because
those are target specific, this header is the same and so it could be
just in .../9.0.0/include/ always (like e.g. the std*.h headers, intrinsics
etc.).
Jakub
^ permalink raw reply [flat|nested] 16+ messages in thread
* Re: ISO_Fortran_binding patch
2019-01-15 8:02 ` Jakub Jelinek
@ 2019-01-15 19:58 ` Paul Richard Thomas
0 siblings, 0 replies; 16+ messages in thread
From: Paul Richard Thomas @ 2019-01-15 19:58 UTC (permalink / raw)
To: Jakub Jelinek
Cc: Richard Biener, Steve Kargl, Thomas Koenig, fortran, gcc-patches
Hi everybody,
I have done the minimum to make the testsuite failures to go
away(thanks, Jakub) and to fix the first (offline) reported bug.
Committed as r267946.
As to the location of ISO_Fortran_binding_2.h, I am open to proposed
fixes. Thomas kindly engineered that part of the original patch since
I have tried to keep my nose out of the configure side of things.
Regards
Paul
2019-01-15 Paul Thomas <pault@gcc.gnu.org>
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Deal with exprs
that are indirect references; ie. dummy arguments.
2019-01-15 Paul Thomas <pault@gcc.gnu.org>
* gfortran.dg/ISO_Fortran_binding_2.c : Change reference to
ISO_Fortran_binding_2.h.
On Tue, 15 Jan 2019 at 08:02, Jakub Jelinek <jakub@redhat.com> wrote:
>
> On Tue, Jan 15, 2019 at 08:05:59AM +0100, Richard Biener wrote:
> > >It either should
> > >#include "../../../libgfortran/ISO_Fortran_binding.h"
> > >instead or the Fortran *.exp files should arrange for
> > >-I.../libgfortran/
> > >to be added to all gfortran tests. Because right now it FAILs if you
> > >don't
> > >have ISO_Fortran_binding.h header installed, or succeeds, but includes
> > >header from some other compiler version or even other compiler
> > >altogether.
>
> This still needs to be fixed.
>
> > >Where is that header installed BTW?
> > >Would be best if it got installed in directories like:
> > >$prefix/lib/gcc/$target/$version/include
> > >
> > >See e.g. libssp or libsanitizer, both have something like
> > >target_noncanonical = @target_noncanonical@
> > >libsubincludedir =
> > >$(libdir)/gcc/$(target_noncanonical)/$(gcc_version)/include
> > >nobase_libsubinclude_HEADERS = ssp/ssp.h ssp/string.h ssp/stdio.h
> > >ssp/unistd.h
> > >
> > >You probably want it to go directly in the include dir, so without the
> > >ssp/
> > >or whatever else prefixes.
> >
> > It's there, but also in the multilib locations (which is dubious? Not sure if we ever search tose include paths)
>
> Yeah, for -m32 it is in
> .../lib/gcc/x86_64-pc-linux-gnu/9.0.0/32/include/
> which isn't that useful; while the finclude/ in there is needed, because
> those are target specific, this header is the same and so it could be
> just in .../9.0.0/include/ always (like e.g. the std*.h headers, intrinsics
> etc.).
>
> Jakub
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 16+ messages in thread
end of thread, other threads:[~2019-01-15 19:58 UTC | newest]
Thread overview: 16+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-01-07 20:29 ISO_Fortran_binding patch Paul Richard Thomas
2019-01-08 23:19 ` Thomas Koenig
2019-01-09 9:21 ` Paul Richard Thomas
2019-01-09 20:08 ` Thomas Koenig
2019-01-09 20:37 ` Damian Rouson
2019-01-09 23:07 ` Paul Richard Thomas
2019-01-12 15:28 ` Paul Richard Thomas
2019-01-12 17:10 ` Steve Kargl
2019-01-12 17:17 ` Steve Kargl
2019-01-12 18:29 ` Paul Richard Thomas
2019-01-12 18:35 ` Paul Richard Thomas
2019-01-14 23:08 ` Jakub Jelinek
2019-01-15 0:08 ` Steve Kargl
2019-01-15 7:06 ` Richard Biener
2019-01-15 8:02 ` Jakub Jelinek
2019-01-15 19:58 ` Paul Richard Thomas
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).