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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
From 48167dc2032887845cf3ca5570c783bb38e3b930 Mon Sep 17 00:00:00 2001
From: burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed, 11 May 2011 20:31:14 +0000
Subject: [PATCH] 2011-05-11 Tobias Burnus <burnus@net-b.de>
PR fortran/48889
* expr.c (gfc_is_constant_expr): Use e->value.function.esym
instead of e->symtree->n.sym, if available.
2011-05-11 Tobias Burnus <burnus@net-b.de>
PR fortran/48889
* gfortran.dg/generic_24.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_6-branch@173675 138bc75d-0d04-0410-961f-82ee72b054a4
index cfa1d57..76272c4 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -894,6 +894,9 @@ gfc_is_constant_expr (gfc_expr *e)
case EXPR_FUNCTION:
case EXPR_PPC:
case EXPR_COMPCALL:
+ gcc_assert (e->symtree || e->value.function.esym
+ || e->value.function.isym);
+
/* Call to intrinsic with at least one argument. */
if (e->value.function.isym && e->value.function.actual)
{
@@ -902,13 +905,14 @@ gfc_is_constant_expr (gfc_expr *e)
return 0;
}
- /* Make sure we have a symbol. */
- gcc_assert (e->symtree);
-
- sym = e->symtree->n.sym;
-
/* Specification functions are constant. */
/* F95, 7.1.6.2; F2003, 7.1.7 */
+ sym = NULL;
+ if (e->symtree)
+ sym = e->symtree->n.sym;
+ if (e->value.function.esym)
+ sym = e->value.function.esym;
+
if (sym
&& sym->attr.function
&& sym->attr.pure
new file mode 100644
index 0000000..2388722
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_24.f90
@@ -0,0 +1,100 @@
+! { dg-do compile }
+!
+! PR fortran/48889
+!
+! Thanks for
+! reporting to Lawrence Mitchell
+! for the test case to David Ham
+!
+module sparse_tools
+ implicit none
+ private
+
+ type csr_foo
+ integer, dimension(:), pointer :: colm=>null()
+ end type csr_foo
+
+ type block_csr_matrix
+ type(csr_foo) :: sparsity
+ end type block_csr_matrix
+
+ interface attach_block
+ module procedure block_csr_attach_block
+ end interface
+
+ interface size
+ module procedure sparsity_size
+ end interface
+
+ public :: size, attach_block
+contains
+ subroutine block_csr_attach_block(matrix, val)
+ type(block_csr_matrix), intent(inout) :: matrix
+ real, dimension(size(matrix%sparsity%colm)), intent(in), target :: val
+ end subroutine block_csr_attach_block
+
+ pure function sparsity_size(sparsity, dim)
+ integer :: sparsity_size
+ type(csr_foo), intent(in) :: sparsity
+ integer, optional, intent(in) :: dim
+ end function sparsity_size
+end module sparse_tools
+
+module global_numbering
+ use sparse_tools
+ implicit none
+
+ type ele_numbering_type
+ integer :: boundaries
+ end type ele_numbering_type
+
+ type element_type
+ integer :: loc
+ type(ele_numbering_type), pointer :: numbering=>null()
+ end type element_type
+
+ type csr_sparsity
+ end type csr_sparsity
+
+ interface size
+ module procedure sparsity_size
+ end interface size
+contains
+ pure function sparsity_size(sparsity, dim)
+ integer :: sparsity_size
+ type(csr_sparsity), intent(in) :: sparsity
+ integer, optional, intent(in) :: dim
+ end function sparsity_size
+
+ subroutine make_boundary_numbering(EEList, xndglno, ele_n)
+ type(csr_sparsity), intent(in) :: EEList
+ type(element_type), intent(in) :: ele_n
+ integer, dimension(size(EEList,1)*ele_n%loc), intent(in), target ::&
+ & xndglno
+ integer, dimension(ele_n%numbering%boundaries) :: neigh
+ integer :: j
+ j=size(neigh)
+ end subroutine make_boundary_numbering
+end module global_numbering
+
+module sparse_matrices_fields
+ use sparse_tools
+implicit none
+ type scalar_field
+ real, dimension(:), pointer :: val
+ end type scalar_field
+contains
+ subroutine csr_mult_T_scalar(x)
+ type(scalar_field), intent(inout) :: x
+ real, dimension(:), allocatable :: tmp
+ integer :: i
+ i=size(x%val)
+ end subroutine csr_mult_T_scalar
+end module sparse_matrices_fields
+
+program test
+ use sparse_matrices_fields
+ use global_numbering
+end program test
+
+! { dg-final { cleanup-modules "sparse_tools sparse_matrices_fields global_numbering" } }
--
1.7.0.4
|
