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