1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
From 2dafec1aa5217475f84c316a2e15bd8f197c12e3 Mon Sep 17 00:00:00 2001
From: langton <langton@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Mon, 6 Jun 2011 18:17:26 +0000
Subject: [PATCH] PR fortran/49268
* trans-decl.c (gfc_trans_deferred_vars): Treat assumed-size Cray
pointees as AS_EXPLICIT.
PR fortran/49268
* gfortran.dg/PR49268.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_6-branch@174719 138bc75d-0d04-0410-961f-82ee72b054a4
index 08207e0..9add565 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3388,7 +3388,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (sym->attr.dimension)
{
- switch (sym->as->type)
+ /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT. */
+ array_type tmp = sym->as->type;
+ if (tmp == AS_ASSUMED_SIZE && sym->as->cp_was_assumed)
+ tmp = AS_EXPLICIT;
+ switch (tmp)
{
case AS_EXPLICIT:
if (sym->attr.dummy || sym->attr.result)
new file mode 100644
index 0000000..5b274cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR49268.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-options "-fcray-pointer" }
+
+! Test the fix for a runtime error
+! Contributed by Mike Kumbera <kumbera1@llnl.gov>
+
+ program bob
+ implicit none
+ integer*8 ipfoo
+ integer n,m,i,j
+ real*8 foo
+
+ common /ipdata/ ipfoo
+ common /ipsize/ n,m
+ POINTER ( ipfoo, foo(3,7) )
+
+ n=3
+ m=7
+
+ ipfoo=malloc(8*n*m)
+ do i=1,n
+ do j=1,m
+ foo(i,j)=1.d0
+ end do
+ end do
+ call use_foo()
+ end program bob
+
+
+ subroutine use_foo()
+ implicit none
+ integer n,m,i,j
+ integer*8 ipfoo
+ common /ipdata/ ipfoo
+ common /ipsize/ n,m
+ real*8 foo,boo
+
+ !fails if * is the last dimension
+ POINTER ( ipfoo, foo(n,*) )
+
+ !works if the last dimension is specified
+ !POINTER ( ipfoo, foo(n,m) )
+ boo=0.d0
+ do i=1,n
+ do j=1,m
+ boo=foo(i,j)+1.0
+ if (abs (boo - 2.0) .gt. 1e-6) call abort
+ end do
+ end do
+
+ end subroutine use_foo
--
1.7.0.4
|
