From 8327f9c2da69615df75f9748308d6fdb38149cea Mon Sep 17 00:00:00 2001
From: Tobias Burnus <burnus@net-b.de>
Date: Sun, 24 Aug 2008 22:31:09 +0200
Subject: [PATCH] re PR fortran/37201 (ICE in in gfc_conv_string_parameter)
2008-08-24 Tobias Burnus <burnus@net-b.de>
PR fortran/37201
* decl.c (verify_bind_c_sym): Reject array/string returning
functions.
2008-08-24 Tobias Burnus <burnus@net-b.de>
PR fortran/37201
* gfortran.dg/bind_c_18.f90: New.
From-SVN: r139545
---
gcc/fortran/ChangeLog | 6 +++++
gcc/fortran/decl.c | 35 ++++++++++++++-----------
gcc/testsuite/ChangeLog | 5 ++++
gcc/testsuite/gfortran.dg/bind_c_18.f90 | 19 ++++++++++++++
4 files changed, 50 insertions(+), 15 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/bind_c_18.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5700f0fbddd0..8c8c679549ab 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2008-08-24 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/37201
+ * decl.c (verify_bind_c_sym): Reject array/string returning
+ functions.
+
2008-08-24 Tobias Burnus <burnus@net-b.de>
PR fortran/37201
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7ccee8b76a4c..406b5af345dd 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3368,8 +3368,12 @@ gfc_try
verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
int is_in_common, gfc_common_head *com_block)
{
+ bool bind_c_function = false;
gfc_try retval = SUCCESS;
+ if (tmp_sym->attr.function && tmp_sym->attr.is_bind_c)
+ bind_c_function = true;
+
if (tmp_sym->attr.function && tmp_sym->result != NULL)
{
tmp_sym = tmp_sym->result;
@@ -3385,7 +3389,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
tmp_sym->attr.is_c_interop = 1;
}
}
-
+
/* Here, we know we have the bind(c) attribute, so if we have
enough type info, then verify that it's a C interop kind.
The info could be in the symbol already, or possibly still in
@@ -3451,22 +3455,23 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
retval = FAILURE;
}
- /* If it is a BIND(C) function, make sure the return value is a
- scalar value. The previous tests in this function made sure
- the type is interoperable. */
- if (tmp_sym->attr.function == 1 && tmp_sym->as != NULL)
- gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
- "be an array", tmp_sym->name, &(tmp_sym->declared_at));
-
- /* BIND(C) functions can not return a character string. */
- if (tmp_sym->attr.function == 1 && tmp_sym->ts.type == BT_CHARACTER)
- if (tmp_sym->ts.cl == NULL || tmp_sym->ts.cl->length == NULL
- || tmp_sym->ts.cl->length->expr_type != EXPR_CONSTANT
- || mpz_cmp_si (tmp_sym->ts.cl->length->value.integer, 1) != 0)
- gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+ }
+
+ /* If it is a BIND(C) function, make sure the return value is a
+ scalar value. The previous tests in this function made sure
+ the type is interoperable. */
+ if (bind_c_function && tmp_sym->as != NULL)
+ gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+ "be an array", tmp_sym->name, &(tmp_sym->declared_at));
+
+ /* BIND(C) functions can not return a character string. */
+ if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
+ if (tmp_sym->ts.cl == NULL || tmp_sym->ts.cl->length == NULL
+ || tmp_sym->ts.cl->length->expr_type != EXPR_CONSTANT
+ || mpz_cmp_si (tmp_sym->ts.cl->length->value.integer, 1) != 0)
+ gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
"be a character string", tmp_sym->name,
&(tmp_sym->declared_at));
- }
}
/* See if the symbol has been marked as private. If it has, make sure
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7c63b60d1185..0a06a36c24c8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-08-24 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/37201
+ * gfortran.dg/bind_c_18.f90: New.
+
2008-08-24 Jan Hubicka <jh@suse.cz>
* gcc.dg/ipa/ipacost-1.c: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/bind_c_18.f90 b/gcc/testsuite/gfortran.dg/bind_c_18.f90
new file mode 100644
index 000000000000..6360f01aacca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_18.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR fortran/37201
+!
+! Before character arrays were allowed as bind(C) return value.
+!
+implicit none
+ INTERFACE
+ FUNCTION my() BIND(C,name="my") RESULT(r) ! { dg-error "cannot be an array" }
+ USE iso_c_binding
+ CHARACTER(kind=C_CHAR) :: r(10)
+ END FUNCTION
+ END INTERFACE
+ INTERFACE
+ FUNCTION two() BIND(C,name="two") RESULT(r) ! { dg-error "cannot be a character string" }
+ USE iso_c_binding
+ CHARACTER(kind=C_CHAR,len=2) :: r
+ END FUNCTION
+ END INTERFACE
+END
--
GitLab