File tree Expand file tree Collapse file tree 2 files changed +44
-1
lines changed Expand file tree Collapse file tree 2 files changed +44
-1
lines changed Original file line number Diff line number Diff line change @@ -2353,7 +2353,11 @@ DynamicType IntrinsicProcTable::Implementation::GetSpecificType(
2353
2353
const CategorySet &set{pattern.categorySet };
2354
2354
CHECK (set.count () == 1 );
2355
2355
TypeCategory category{set.LeastElement ().value ()};
2356
- return DynamicType{category, defaults_.GetDefaultKind (category)};
2356
+ if (pattern.kindCode == KindCode::doublePrecision) {
2357
+ return DynamicType{category, defaults_.doublePrecisionKind ()};
2358
+ } else {
2359
+ return DynamicType{category, defaults_.GetDefaultKind (category)};
2360
+ }
2357
2361
}
2358
2362
2359
2363
IntrinsicProcTable::~IntrinsicProcTable () = default ;
Original file line number Diff line number Diff line change
1
+ ! RUN: %S/test_errors.sh %s %t %flang_fc1
2
+ ! REQUIRES: shell
3
+
4
+ ! Test that the interface of specific intrinsics passed as dummy arguments
5
+ ! are correctly validated against actual arguments explicit interface.
6
+
7
+ intrinsic :: abs, dabs
8
+ interface
9
+ subroutine foo (f )
10
+ interface
11
+ function f (x )
12
+ real :: f
13
+ real , intent (in ) :: x
14
+ end function
15
+ end interface
16
+ end subroutine
17
+
18
+ subroutine foo2 (f )
19
+ interface
20
+ function f (x )
21
+ double precision :: f
22
+ double precision , intent (in ) :: x
23
+ end function
24
+ end interface
25
+ end subroutine
26
+ end interface
27
+
28
+ ! OK
29
+ call foo(abs)
30
+
31
+ ! OK
32
+ call foo2(dabs)
33
+
34
+ ! ERROR: Actual procedure argument has interface incompatible with dummy argument 'f='
35
+ call foo(dabs)
36
+
37
+ ! ERROR: Actual procedure argument has interface incompatible with dummy argument 'f='
38
+ call foo2(abs)
39
+ end
You can’t perform that action at this time.
0 commit comments