From 304d779b9ebeb30fd8761703b5729b51db450793 Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Sat, 8 Jun 2019 13:50:42 +0000
Subject: [PATCH] re PR fortran/90744 (Bogus length for character temporaries
passed to external procedures since r268992)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
2019-06-08 Thomas Koenig <tkoenig@gcc.gnu.org>
Tomáš Trnka <trnka@scm.com>
PR fortran/90744
* trans-types.c (get_formal_from_actual_arglist): Unset typespec
flags which make no sense for procedures without explicit
interface.
2019-06-08 Thomas Koenig <tkoenig@gcc.gnu.org>
Tomáš Trnka <trnka@scm.com>
PR fortran/90744
* gfortran.dg/deferred_character_33.f90: New test.
* gfortran.dg/deferred_character_33a.f90: New test.
From-SVN: r272082
---
gcc/fortran/ChangeLog | 8 +++++
gcc/fortran/trans-types.c | 3 ++
gcc/testsuite/ChangeLog | 9 ++++-
.../gfortran.dg/deferred_character_33.f90 | 35 +++++++++++++++++++
.../gfortran.dg/deferred_character_33a.f90 | 9 +++++
5 files changed, 63 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/deferred_character_33.f90
create mode 100644 gcc/testsuite/gfortran.dg/deferred_character_33a.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1c3f8bc5948b..20fe2c382456 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2019-06-08 Thomas Koenig <tkoenig@gcc.gnu.org>
+ Tomáš Trnka <trnka@scm.com>
+
+ PR fortran/90744
+ * trans-types.c (get_formal_from_actual_arglist): Unset typespec
+ flags which make no sense for procedures without explicit
+ interface.
+
2019-06-02 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/90539
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index e16de59f6668..d236f37be6d6 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -3005,6 +3005,9 @@ get_formal_from_actual_arglist (gfc_symbol *sym, gfc_actual_arglist *actual_args
else
{
s->ts = a->expr->ts;
+ s->ts.deferred = 0;
+ s->ts.is_iso_c = 0;
+ s->ts.is_c_interop = 0;
s->attr.flavor = FL_VARIABLE;
if (a->expr->rank > 0)
{
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a554e88ac48f..c7846a4addbd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-06-08 Thomas Koenig <tkoenig@gcc.gnu.org>
+ Tomáš Trnka <trnka@scm.com>
+
+ PR fortran/90744
+ * gfortran.dg/deferred_character_33.f90: New test.
+ * gfortran.dg/deferred_character_33a.f90: New test.
+
2019-06-08 Marek Polacek <polacek@redhat.com>
PR c++/77548
@@ -10,7 +17,7 @@
* gcc.target/aarch64/sve/init_1.c: Remove options
-O2 -fno-schedule-insns and instead pass -O.
- Update assembly in comments.
+ Update assembly in comments.
* gcc.target/aarch64/sve/init_2.c: Likewise.
* gcc.target/aarch64/sve/init_3.c: Likewise.
* gcc.target/aarch64/sve/init_4.c: Likewise.
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_33.f90 b/gcc/testsuite/gfortran.dg/deferred_character_33.f90
new file mode 100644
index 000000000000..ec864d83c314
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_33.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! { dg-additional-sources deferred_character_33a.f90 }
+! PR fortran/90744 - this used to pass a wrong length
+! to an external function without a prototype.
+! Original test case by Tomáš Trnka.
+module StringModule
+ implicit none
+
+contains
+ function getstr()
+ character(:), allocatable :: getstr
+
+ getstr = 'OK'
+ end function
+end module
+module TestModule
+ use StringModule
+ implicit none
+
+contains
+ subroutine DoTest()
+ if (.false.) then
+ call convrs('A',getstr())
+ else
+ call convrs('B',getstr())
+ end if
+ end subroutine
+end module
+program external_char_length
+ use TestModule
+
+ implicit none
+
+ call DoTest()
+end program
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_33a.f90 b/gcc/testsuite/gfortran.dg/deferred_character_33a.f90
new file mode 100644
index 000000000000..db117cc0b381
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_33a.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+subroutine convrs(quanty,fromto)
+ implicit none
+
+ character(*), intent(in) :: quanty,fromto
+
+ if (len(fromto) /= 2) stop 1
+ if (fromto /= 'OK') stop 2
+end subroutine
--
GitLab