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(
23532353 const CategorySet &set{pattern.categorySet };
23542354 CHECK (set.count () == 1 );
23552355 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+ }
23572361}
23582362
23592363IntrinsicProcTable::~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