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 if (len < toLength) { 75 std::memcpy(to, from, len); 76 std::memset(to + len, ' ', toLength - len); 77 } else { 78 std::memcpy(to, from, toLength); 79 } 80 } 81 82 void CheckConformability(const Descriptor &to, const Descriptor &x, 83 Terminator &terminator, const char *funcName, const char *toName, 84 const char *xName) { 85 if (x.rank() == 0) { 86 return; // scalar conforms with anything 87 } 88 int rank{to.rank()}; 89 if (x.rank() != rank) { 90 terminator.Crash( 91 "Incompatible array arguments to %s: %s has rank %d but %s has rank %d", 92 funcName, toName, rank, xName, x.rank()); 93 } else { 94 for (int j{0}; j < rank; ++j) { 95 auto toExtent{static_cast<std::int64_t>(to.GetDimension(j).Extent())}; 96 auto xExtent{static_cast<std::int64_t>(x.GetDimension(j).Extent())}; 97 if (xExtent != toExtent) { 98 terminator.Crash("Incompatible array arguments to %s: dimension %d of " 99 "%s has extent %" PRId64 " but %s has extent %" PRId64, 100 funcName, j, toName, toExtent, xName, xExtent); 101 } 102 } 103 } 104 } 105 106 void CheckIntegerKind(Terminator &terminator, int kind, const char *intrinsic) { 107 if (kind < 1 || kind > 16 || (kind & (kind - 1)) != 0) { 108 terminator.Crash("%s: bad KIND=%d argument", intrinsic, kind); 109 } 110 } 111 } // namespace Fortran::runtime 112