aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/intrinsic.c
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2013-03-25 16:40:26 +0100
committerTobias Burnus <burnus@gcc.gnu.org>2013-03-25 16:40:26 +0100
commitcadddfdda2c4a16e7fdd5f0d8d02b465caad2ad5 (patch)
tree8a59184d212dad5695956782c588f54b5ed68b53 /gcc/fortran/intrinsic.c
parenta5a4c20a5c922f2faa66b9326b336b5d7eb5065e (diff)
downloadgcc-cadddfdda2c4a16e7fdd5f0d8d02b465caad2ad5.zip
gcc-cadddfdda2c4a16e7fdd5f0d8d02b465caad2ad5.tar.gz
gcc-cadddfdda2c4a16e7fdd5f0d8d02b465caad2ad5.tar.bz2
re PR fortran/38536 (ICE with C_LOC in resolve.c due to not properly going through expr->ref)
2013-03-25 Tobias Burnus <burnus@net-b.de> PR fortran/38536 PR fortran/38813 PR fortran/38894 PR fortran/39288 PR fortran/40963 PR fortran/45824 PR fortran/47023 PR fortran/47034 PR fortran/49023 PR fortran/50269 PR fortran/50612 PR fortran/52426 PR fortran/54263 PR fortran/55343 PR fortran/55444 PR fortran/55574 PR fortran/56079 PR fortran/56378 * check.c (gfc_var_strlen): Properly handle 0-sized string. (gfc_check_c_sizeof): Use is_c_interoperable, add checks. (is_c_interoperable, gfc_check_c_associated, gfc_check_c_f_pointer, gfc_check_c_f_procpointer, gfc_check_c_funloc, gfc_check_c_loc): New functions. * expr.c (check_inquiry): Add c_sizeof, compiler_version and compiler_options. (gfc_check_pointer_assign): Refine function result check. gfortran.h (gfc_isym_id): Add GFC_ISYM_C_ASSOCIATED, GFC_ISYM_C_F_POINTER, GFC_ISYM_C_F_PROCPOINTER, GFC_ISYM_C_FUNLOC, GFC_ISYM_C_LOC. (iso_fortran_env_symbol, iso_c_binding_symbol): Handle NAMED_SUBROUTINE. (generate_isocbinding_symbol): Update prototype. (get_iso_c_sym): Remove. (gfc_isym_id_by_intmod, gfc_isym_id_by_intmod_sym): New prototypes. * intrinsic.c (gfc_intrinsic_subroutine_by_id): New function. (gfc_intrinsic_sub_interface): Use it. (add_functions, add_subroutines): Add missing C-binding intrinsics. (gfc_intrinsic_func_interface): Add special case for c_loc. gfc_isym_id_by_intmod, gfc_isym_id_by_intmod_sym): New functions. (gfc_intrinsic_func_interface, gfc_intrinsic_sub_interface): Use them. * intrinsic.h (gfc_check_c_associated, gfc_check_c_f_pointer, gfc_check_c_f_procpointer, gfc_check_c_funloc, gfc_check_c_loc, gfc_resolve_c_loc, gfc_resolve_c_funloc): New prototypes. * iresolve.c (gfc_resolve_c_loc, gfc_resolve_c_funloc): New functions. * iso-c-binding.def: Split PROCEDURE into NAMED_SUBROUTINE and NAMED_FUNCTION. * iso-fortran-env.def: Add NAMED_SUBROUTINE for completeness. * module.c (create_intrinsic_function): Support subroutines and derived-type results. (use_iso_fortran_env_module): Update calls. (import_iso_c_binding_module): Ditto; update calls to generate_isocbinding_symbol. * resolve.c (find_arglists): Skip for intrinsic symbols. (gfc_resolve_intrinsic): Find intrinsic subs via id. (is_scalar_expr_ptr, gfc_iso_c_func_interface, set_name_and_label, gfc_iso_c_sub_interface): Remove. (resolve_function, resolve_specific_s0): Remove calls to those. (resolve_structure_cons): Fix handling. * symbol.c (gen_special_c_interop_ptr): Update c_ptr/c_funptr generation. (gen_cptr_param, gen_fptr_param, gen_shape_param, build_formal_args, get_iso_c_sym): Remove. (std_for_isocbinding_symbol): Handle NAMED_SUBROUTINE. (generate_isocbinding_symbol): Support hidden symbols and using c_ptr/c_funptr symtrees for nullptr defs. * target-memory.c (gfc_target_encode_expr): Fix handling of c_ptr/c_funptr. * trans-expr.c (conv_isocbinding_procedure): Remove. (gfc_conv_procedure_call): Remove call to it. (gfc_trans_subcomponent_assign, gfc_conv_expr): Update handling of c_ptr/c_funptr. * trans-intrinsic.c (conv_isocbinding_function, conv_isocbinding_subroutine): New. (gfc_conv_intrinsic_function, gfc_conv_intrinsic_subroutine): Call them. * trans-io.c (transfer_expr): Fix handling of c_ptr/c_funptr. * trans-types.c (gfc_typenode_for_spec, gfc_get_derived_type): Ditto. (gfc_init_c_interop_kinds): Handle NAMED_SUBROUTINE. 2013-03-25 Tobias Burnus <burnus@net-b.de> PR fortran/38536 PR fortran/38813 PR fortran/38894 PR fortran/39288 PR fortran/40963 PR fortran/45824 PR fortran/47023 PR fortran/47034 PR fortran/49023 PR fortran/50269 PR fortran/50612 PR fortran/52426 PR fortran/54263 PR fortran/55343 PR fortran/55444 PR fortran/55574 PR fortran/56079 PR fortran/56378 * gfortran.dg/c_assoc_2.f03: Update dg-error wording. * gfortran.dg/c_f_pointer_shape_test.f90: Ditto. * gfortran.dg/c_f_pointer_shape_tests_3.f03: Ditto. * gfortran.dg/c_f_pointer_tests_5.f90: Ditto. * gfortran.dg/c_funloc_tests_2.f03: Ditto. * gfortran.dg/c_funloc_tests_5.f03: Ditto. * gfortran.dg/c_funloc_tests_6.f90: Ditto. * gfortran.dg/c_loc_tests_10.f03: Add -std=f2008. * gfortran.dg/c_loc_tests_11.f03: Ditto, update dg-error. * gfortran.dg/c_loc_tests_16.f90: Ditto. * gfortran.dg/c_loc_tests_4.f03: Ditto. * gfortran.dg/c_loc_tests_15.f90: Update dg-error wording. * gfortran.dg/c_loc_tests_3.f03: Valid since F2003 TC5. * gfortran.dg/c_loc_tests_8.f03: Ditto. * gfortran.dg/c_ptr_tests_14.f90: Update scan-tree-dump-times. * gfortran.dg/c_ptr_tests_15.f90: Ditto. * gfortran.dg/c_sizeof_1.f90: Fix invalid code. * gfortran.dg/iso_c_binding_init_expr.f03: Update dg-error wording. * gfortran.dg/pr32601_1.f03: Ditto. * gfortran.dg/storage_size_2.f08: Remove dg-error. * gfortran.dg/blockdata_7.f90: New. * gfortran.dg/c_assoc_4.f90: New. * gfortran.dg/c_f_pointer_tests_6.f90: New. * gfortran.dg/c_f_pointer_tests_7.f90: New. * gfortran.dg/c_funloc_tests_8.f90: New. * gfortran.dg/c_loc_test_17.f90: New. * gfortran.dg/c_loc_test_18.f90: New. * gfortran.dg/c_loc_test_19.f90: New. * gfortran.dg/c_loc_test_20.f90: New. * gfortran.dg/c_sizeof_5.f90: New. * gfortran.dg/iso_c_binding_rename_3.f90: New. * gfortran.dg/transfer_resolve_2.f90: New. * gfortran.dg/transfer_resolve_3.f90: New. * gfortran.dg/transfer_resolve_4.f90: New. * gfortran.dg/pr32601.f03: Update dg-error. * gfortran.dg/c_ptr_tests_13.f03: Update dg-error. * gfortran.dg/c_ptr_tests_9.f03: Fix test case. From-SVN: r197053
Diffstat (limited to 'gcc/fortran/intrinsic.c')
-rw-r--r--gcc/fortran/intrinsic.c107
1 files changed, 100 insertions, 7 deletions
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index c571533..358c33e 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -810,6 +810,57 @@ find_sym (gfc_intrinsic_sym *start, int n, const char *name)
}
+gfc_isym_id
+gfc_isym_id_by_intmod (intmod_id from_intmod, int intmod_sym_id)
+{
+ if (from_intmod == INTMOD_ISO_C_BINDING)
+ return (gfc_isym_id) c_interop_kinds_table[intmod_sym_id].value;
+ else if (from_intmod == INTMOD_ISO_FORTRAN_ENV)
+ switch (intmod_sym_id)
+ {
+#define NAMED_SUBROUTINE(a,b,c,d) \
+ case a: \
+ return (gfc_isym_id) c;
+#define NAMED_FUNCTION(a,b,c,d) \
+ case a: \
+ return (gfc_isym_id) c;
+#include "iso-fortran-env.def"
+ default:
+ gcc_unreachable ();
+ }
+ else
+ {
+ gcc_unreachable ();
+ }
+ return (gfc_isym_id) 0;
+}
+
+
+gfc_isym_id
+gfc_isym_id_by_intmod_sym (gfc_symbol *sym)
+{
+ return gfc_isym_id_by_intmod (sym->from_intmod, sym->intmod_sym_id);
+}
+
+
+gfc_intrinsic_sym *
+gfc_intrinsic_subroutine_by_id (gfc_isym_id id)
+{
+ gfc_intrinsic_sym *start = subroutines;
+ int n = nsub;
+
+ while (true)
+ {
+ gcc_assert (n > 0);
+ if (id == start->id)
+ return start;
+
+ start++;
+ n--;
+ }
+}
+
+
gfc_intrinsic_sym *
gfc_intrinsic_function_by_id (gfc_isym_id id)
{
@@ -2652,9 +2703,28 @@ add_functions (void)
make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
- /* C_SIZEOF is part of ISO_C_BINDING. */
+ /* The following functions are part of ISO_C_BINDING. */
+ add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO,
+ BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL,
+ "C_PTR_1", BT_VOID, 0, REQUIRED,
+ "C_PTR_2", BT_VOID, 0, OPTIONAL);
+ make_from_module();
+
+ add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO,
+ BT_VOID, 0, GFC_STD_F2003,
+ gfc_check_c_loc, NULL, gfc_resolve_c_loc,
+ x, BT_UNKNOWN, 0, REQUIRED);
+ make_from_module();
+
+ add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC, CLASS_INQUIRY, ACTUAL_NO,
+ BT_VOID, 0, GFC_STD_F2003,
+ gfc_check_c_funloc, NULL, gfc_resolve_c_funloc,
+ x, BT_UNKNOWN, 0, REQUIRED);
+ make_from_module();
+
add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
- BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
+ BT_INTEGER, gfc_index_integer_kind, GFC_STD_F2008,
+ gfc_check_c_sizeof, NULL, NULL,
x, BT_UNKNOWN, 0, REQUIRED);
make_from_module();
@@ -3056,6 +3126,22 @@ add_subroutines (void)
pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+ /* The following subroutines are part of ISO_C_BINDING. */
+
+ add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER, CLASS_IMPURE, BT_UNKNOWN, 0,
+ GFC_STD_F2003, gfc_check_c_f_pointer, NULL, NULL,
+ "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
+ "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT,
+ "shape", BT_INTEGER, di, OPTIONAL, INTENT_IN);
+ make_from_module();
+
+ add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER, CLASS_IMPURE,
+ BT_UNKNOWN, 0, GFC_STD_F2003, gfc_check_c_f_procpointer,
+ NULL, NULL,
+ "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
+ "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
+ make_from_module();
+
/* More G77 compatibility garbage. */
add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
@@ -4078,8 +4164,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
if (expr->symtree->n.sym->intmod_sym_id)
{
- int id = expr->symtree->n.sym->intmod_sym_id;
- isym = specific = gfc_intrinsic_function_by_id ((gfc_isym_id) id);
+ gfc_isym_id id = gfc_isym_id_by_intmod_sym (expr->symtree->n.sym);
+ isym = specific = gfc_intrinsic_function_by_id (id);
}
else
isym = specific = gfc_find_function (name);
@@ -4105,12 +4191,12 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
gfc_current_intrinsic_where = &expr->where;
- /* Bypass the generic list for min and max. */
+ /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
if (isym->check.f1m == gfc_check_min_max)
{
init_arglist (isym);
- if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
+ if (isym->check.f1m (expr->value.function.actual) == SUCCESS)
goto got_specific;
if (!error_flag)
@@ -4192,7 +4278,14 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
name = c->symtree->n.sym->name;
- isym = gfc_find_subroutine (name);
+ if (c->symtree->n.sym->intmod_sym_id)
+ {
+ gfc_isym_id id;
+ id = gfc_isym_id_by_intmod_sym (c->symtree->n.sym);
+ isym = gfc_intrinsic_subroutine_by_id (id);
+ }
+ else
+ isym = gfc_find_subroutine (name);
if (isym == NULL)
return MATCH_NO;