1 //===-- runtime/tools.cpp ---------------------------------------*- C++ -*-===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "tools.h"
10 #include "terminator.h"
11 #include <algorithm>
12 #include <cstdint>
13 #include <cstring>
14 
15 namespace Fortran::runtime {
16 
17 std::size_t TrimTrailingSpaces(const char *s, std::size_t n) {
18   while (n > 0 && s[n - 1] == ' ') {
19     --n;
20   }
21   return n;
22 }
23 
24 OwningPtr<char> SaveDefaultCharacter(
25     const char *s, std::size_t length, const Terminator &terminator) {
26   if (s) {
27     auto *p{static_cast<char *>(AllocateMemoryOrCrash(terminator, length + 1))};
28     std::memcpy(p, s, length);
29     p[length] = '\0';
30     return OwningPtr<char>{p};
31   } else {
32     return OwningPtr<char>{};
33   }
34 }
35 
36 static bool CaseInsensitiveMatch(
37     const char *value, std::size_t length, const char *possibility) {
38   for (; length-- > 0; ++possibility) {
39     char ch{*value++};
40     if (ch >= 'a' && ch <= 'z') {
41       ch += 'A' - 'a';
42     }
43     if (*possibility != ch) {
44       if (*possibility != '\0' || ch != ' ') {
45         return false;
46       }
47       // Ignore trailing blanks (12.5.6.2 p1)
48       while (length-- > 0) {
49         if (*value++ != ' ') {
50           return false;
51         }
52       }
53       return true;
54     }
55   }
56   return *possibility == '\0';
57 }
58 
59 int IdentifyValue(
60     const char *value, std::size_t length, const char *possibilities[]) {
61   if (value) {
62     for (int j{0}; possibilities[j]; ++j) {
63       if (CaseInsensitiveMatch(value, length, possibilities[j])) {
64         return j;
65       }
66     }
67   }
68   return -1;
69 }
70 
71 void ToFortranDefaultCharacter(
72     char *to, std::size_t toLength, const char *from) {
73   std::size_t len{std::strlen(from)};
74   std::memcpy(to, from, std::max(toLength, len));
75   if (len < toLength) {
76     std::memset(to + len, ' ', toLength - len);
77   }
78 }
79 
80 void CheckConformability(const Descriptor &to, const Descriptor &x,
81     Terminator &terminator, const char *funcName, const char *toName,
82     const char *xName) {
83   if (x.rank() == 0) {
84     return; // scalar conforms with anything
85   }
86   int rank{to.rank()};
87   if (x.rank() != rank) {
88     terminator.Crash(
89         "Incompatible array arguments to %s: %s has rank %d but %s has rank %d",
90         funcName, toName, rank, xName, x.rank());
91   } else {
92     for (int j{0}; j < rank; ++j) {
93       auto toExtent{static_cast<std::int64_t>(to.GetDimension(j).Extent())};
94       auto xExtent{static_cast<std::int64_t>(x.GetDimension(j).Extent())};
95       if (xExtent != toExtent) {
96         terminator.Crash("Incompatible array arguments to %s: dimension %d of "
97                          "%s has extent %" PRId64 " but %s has extent %" PRId64,
98             funcName, j, toName, toExtent, xName, xExtent);
99       }
100     }
101   }
102 }
103 
104 void CheckIntegerKind(Terminator &terminator, int kind, const char *intrinsic) {
105   if (kind < 1 || kind > 16 || (kind & (kind - 1)) != 0) {
106     terminator.Crash("%s: bad KIND=%d argument", intrinsic, kind);
107   }
108 }
109 
110 } // namespace Fortran::runtime
111