aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTobias Burnus <tobias@codesourcery.com>2021-02-12 11:21:08 +0100
committerTobias Burnus <tobias@codesourcery.com>2021-02-12 11:21:08 +0100
commit88718208897140e63f10ad81b8a69f01b610bb40 (patch)
tree22f341f898ee9fac24acae75ec507ecdaeb03c36
parent7bfdb5a1c694cb9006e0478941e4443b230f5b98 (diff)
downloadgcc-88718208897140e63f10ad81b8a69f01b610bb40.zip
gcc-88718208897140e63f10ad81b8a69f01b610bb40.tar.gz
gcc-88718208897140e63f10ad81b8a69f01b610bb40.tar.bz2
Fortran: Fix some select rank issues [PR97694 and 97723].
Backport from mainline; also fixes PR fortran/99045 2020-12-27 Paul Thomas <pault@gcc.gnu.org> gcc/fortran PR fortran/97694 PR fortran/97723 * check.c (allocatable_check): Select rank temporaries are permitted even though they are treated as associate variables. * resolve.c (gfc_resolve_code): Break on select rank as well as select type so that the block os resolved. * trans-stmt.c (trans_associate_var): Class associate variables that are optional dummies must use the backend_decl. gcc/testsuite/ PR fortran/97694 PR fortran/97723 * gfortran.dg/select_rank_5.f90: New test. (cherry picked from commit c4a678981572c12d158709ace0d3f23dd04cf217)
-rw-r--r--gcc/fortran/ChangeLog.omp15
-rw-r--r--gcc/fortran/check.c13
-rw-r--r--gcc/fortran/resolve.c5
-rw-r--r--gcc/fortran/trans-stmt.c2
-rw-r--r--gcc/testsuite/ChangeLog.omp10
-rw-r--r--gcc/testsuite/gfortran.dg/select_rank_5.f9044
6 files changed, 80 insertions, 9 deletions
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index dc045eb..9dd1f8d 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,18 @@
+2021-02-12 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/99045
+ Backport from mainline
+ 2020-12-27 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/97694
+ PR fortran/97723
+ * check.c (allocatable_check): Select rank temporaries are
+ permitted even though they are treated as associate variables.
+ * resolve.c (gfc_resolve_code): Break on select rank as well as
+ select type so that the block os resolved.
+ * trans-stmt.c (trans_associate_var): Class associate variables
+ that are optional dummies must use the backend_decl.
+
2021-01-22 Kwok Cheung Yeung <kcy@codesourcery.com>
Backport from mainline
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ca6f582..a235a13 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -289,7 +289,7 @@ bin2real (gfc_expr *x, int kind)
}
-/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2real ()
+/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2real ()
converts the string into a REAL of the appropriate kind. The treatment
of the sign bit is processor dependent. */
@@ -377,12 +377,12 @@ gfc_boz2real (gfc_expr *x, int kind)
}
-/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2int ()
+/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2int ()
converts the string into an INTEGER of the appropriate kind. The
treatment of the sign bit is processor dependent. If the converted
value exceeds the range of the type, then wrap-around semantics are
applied. */
-
+
bool
gfc_boz2int (gfc_expr *x, int kind)
{
@@ -975,7 +975,8 @@ allocatable_check (gfc_expr *e, int n)
symbol_attribute attr;
attr = gfc_variable_attr (e, NULL);
- if (!attr.allocatable || attr.associate_var)
+ if (!attr.allocatable
+ || (attr.associate_var && !attr.select_rank_temporary))
{
gfc_error ("%qs argument of %qs intrinsic at %L must be ALLOCATABLE",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
@@ -3230,7 +3231,7 @@ gfc_check_intconv (gfc_expr *x)
|| strcmp (gfc_current_intrinsic, "long") == 0)
{
gfc_error ("%qs intrinsic subprogram at %L has been deprecated. "
- "Use INT intrinsic subprogram.", gfc_current_intrinsic,
+ "Use INT intrinsic subprogram.", gfc_current_intrinsic,
&x->where);
return false;
}
@@ -3958,7 +3959,7 @@ gfc_check_findloc (gfc_actual_arglist *ap)
/* Check the kind of the characters argument match. */
if (a1 && v1 && a->ts.kind != v->ts.kind)
goto incompat;
-
+
d = ap->next->next->expr;
m = ap->next->next->next->expr;
k = ap->next->next->next->next->expr;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 84b5011..78d6130 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11722,8 +11722,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
gfc_resolve_omp_do_blocks (code, ns);
break;
case EXEC_SELECT_TYPE:
- /* Blocks are handled in resolve_select_type because we have
- to transform the SELECT TYPE into ASSOCIATE first. */
+ case EXEC_SELECT_RANK:
+ /* Blocks are handled in resolve_select_type/rank because we
+ have to transform the SELECT TYPE into ASSOCIATE first. */
break;
case EXEC_DO_CONCURRENT:
gfc_do_concurrent_flag = 1;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index e3f052e..54c22e6 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1757,7 +1757,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
if (e->ts.type == BT_CLASS)
{
/* Go straight to the class data. */
- if (sym2->attr.dummy)
+ if (sym2->attr.dummy && !sym2->attr.optional)
{
class_decl = DECL_LANG_SPECIFIC (sym2->backend_decl) ?
GFC_DECL_SAVED_DESCRIPTOR (sym2->backend_decl) :
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 4aa9312..3012c77 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,13 @@
+2021-02-12 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/99045
+ Backport from mainline
+ 2020-12-27 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/97694
+ PR fortran/97723
+ * gfortran.dg/select_rank_5.f90: New test.
+
2021-02-09 Kwok Cheung Yeung <kcy@codesourcery.com>
Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/select_rank_5.f90 b/gcc/testsuite/gfortran.dg/select_rank_5.f90
new file mode 100644
index 0000000..55aa9e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_rank_5.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+! Test the fixes for PR97723 and PR97694.
+!
+! Contributed by Martin <mscfd@gmx.net>
+!
+module mod
+ implicit none
+ private
+ public cssel
+
+contains
+
+function cssel(x) result(s)
+ character(len=:), allocatable :: s
+ class(*), dimension(..), optional, intent(in) :: x
+ if (present(x)) then
+ select rank (x)
+ rank (0)
+ s = '0' ! PR97723: ‘assign’ at (1) is not a function
+ ! PR97694: ICE in trans-stmt.c(trans_associate_var)
+ rank (1)
+ s = '1' ! PR97723: ‘assign’ at (1) is not a function
+ rank default
+ s = '?' ! PR97723: ‘assign’ at (1) is not a function
+ end select
+ else
+ s = '-'
+ end if
+end function cssel
+
+end module mod
+
+program classstar_rank
+ use mod
+ implicit none
+
+ integer :: x
+ real, dimension(1:3) :: y
+ logical, dimension(1:2,1:2) :: z
+
+ if (any ([cssel(x),cssel(y),cssel(z),cssel()] .ne. ['0','1','?','-'])) stop 1
+
+end program classstar_rank