2020-8-20 José Rui Faustino de Sousa <jrfsousa@gmail.com>
authorJosé Rui Faustino de Sousa <jrfsousa@gmail.com>
Sun, 30 Aug 2020 18:03:13 +0000 (18:03 +0000)
committerJosé Rui Faustino de Sousa <jrfsousa@gmail.com>
Sun, 30 Aug 2020 18:03:13 +0000 (18:03 +0000)
gcc/fortran/ChangeLog:

PR fortran/96727
* expr.c (gfc_check_init_expr): Add default error message for the AS_ASSUMED_RANK case.

gcc/testsuite/ChangeLog:

PR fortran/96727
* gfortran.dg/PR96727.f90: New test.

gcc/fortran/expr.c
gcc/testsuite/gfortran.dg/PR96727.f90 [new file with mode: 0644]

index 2ef01f0f14fc4f2a048488085e2ac78525ea5170..68784a235f146f9d7b55e6c3ad374934b5b9f244 100644 (file)
@@ -3007,6 +3007,12 @@ gfc_check_init_expr (gfc_expr *e)
                           e->symtree->n.sym->name, &e->where);
                break;
 
+             case AS_ASSUMED_RANK:
+               gfc_error ("Assumed-rank array %qs at %L is not permitted "
+                          "in an initialization expression",
+                          e->symtree->n.sym->name, &e->where);
+               break;
+
              default:
                gcc_unreachable();
          }
diff --git a/gcc/testsuite/gfortran.dg/PR96727.f90 b/gcc/testsuite/gfortran.dg/PR96727.f90
new file mode 100644 (file)
index 0000000..d45dbb7
--- /dev/null
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! Test the fix for PR96727
+!
+
+program cref_p
+
+  implicit none
+  
+  integer                     :: i
+
+  integer,          parameter :: n = 3
+  integer,          parameter :: p(*) = [(i, i=1,n*n)]
+  character(len=*), parameter :: q = repeat('a', n*n)
+  
+  integer            :: a(n,n)
+  character(len=n*n) :: c
+
+  a = reshape(p, shape=[n,n])
+  call csub(a, c)
+  if (c/=q) stop 1
+  stop
+
+contains
+
+  subroutine csub(a, b)
+    integer,                intent(in)  :: a(..)
+    character(len=size(a)), intent(out) :: b
+
+    b = repeat('a', len(b))
+    return
+  end subroutine csub
+  
+end program cref_p