Răsfoiți Sursa

* Better argument checking for setstring

Michael VAN CANNEYT 2 ani în urmă
părinte
comite
b6fb0e914a

+ 24 - 8
compiler/pinline.pas

@@ -567,14 +567,30 @@ implementation
                   end;
                 procname:='fpc_setstring_'+tstringdef(strpara.resultdef).stringtypname;
                 { decide which version to call based on the second parameter }
-                if not is_shortstring(strpara.resultdef) then
-                  if is_pwidechar(pcharpara.resultdef) or
-                     is_widechar(pcharpara.resultdef) or
-                     ((pcharpara.resultdef.typ=arraydef) and
-                      is_widechar(tarraydef(pcharpara.resultdef).elementdef)) then
-                    procname:=procname+'_pwidechar'
-                  else
-                    procname:=procname+'_pansichar';
+                  // widestring ?
+                if is_pwidechar(pcharpara.resultdef) or
+                   is_widechar(pcharpara.resultdef) or
+                   ((pcharpara.resultdef.typ=arraydef) and
+                    is_widechar(tarraydef(pcharpara.resultdef).elementdef)) then
+                      begin
+                      if is_shortstring(strpara.resultdef) then
+                        // do not allow widestring->shortstring
+                        message(type_e_mismatch)
+                      else
+                        procname:=procname+'_pwidechar'
+                      end
+                // ansistring ?
+                else if is_pchar(pcharpara.resultdef) or
+                        is_char(pcharpara.resultdef) or
+                        ((pcharpara.resultdef.typ=arraydef) and
+                         is_char(tarraydef(pcharpara.resultdef).elementdef)) then
+                  begin
+                  if not is_shortstring(strpara.resultdef) then
+                    procname:=procname+'_pansichar'
+                  end
+                else
+                  // Anything else is error
+                  message(type_e_mismatch)
               end;
           end;
         { default version (for error message) in case of missing or wrong

+ 1 - 1
packages/fcl-db/src/base/fields.inc

@@ -3048,7 +3048,7 @@ begin
   if not GetValue(B) then
     Result := ''
   else
-    SetString(Result, @B[0], length(B) div SizeOf(AnsiChar));
+    SetString(Result, PAnsiChar(@B[0]), length(B) div SizeOf(AnsiChar));
 end;
 
 

+ 1 - 1
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -1637,7 +1637,7 @@ begin
   end;
 
   if Connected and (SQLGetInfo(FDBCHandle, i, @b, sizeof(b), @l) = SQL_SUCCESS) then
-    SetString(Result, @b, l)
+    SetString(Result, PAnsiChar(@b), l)
   else
     Result:='';
 end;

+ 2 - 2
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -1166,8 +1166,8 @@ end;
 function UTF8CompareCallback(user: pointer; len1: longint; data1: pointer; len2: longint; data2: pointer): longint; cdecl;
 var S1, S2: AnsiString;
 begin
-  SetString(S1, data1, len1);
-  SetString(S2, data2, len2);
+  SetString(S1, PAnsiChar(data1), len1);
+  SetString(S2, PAnsiChar(data2), len2);
   Result := UnicodeCompareStr(UTF8Decode(S1), UTF8Decode(S2));
 end;
 

+ 1 - 1
packages/fcl-xml/src/xpath.pp

@@ -2429,7 +2429,7 @@ var
       Tail := Head;
       while (Tail <= L) and not IsXmlWhiteSpace(s[Tail]) do
         Inc(Tail);
-      SetString(Token, @s[Head], Tail - Head);
+      SetString(Token, PUnicodeChar(@s[Head]), Tail - Head);
       Element := doc.GetElementById(Token);
       if Assigned(Element) then
         ns.Add(Element);

+ 1 - 1
packages/rtl-objpas/src/inc/fmtbcd.pp

@@ -2895,7 +2895,7 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
     if j > high(Buf) then
       Result := ''
     else
-      SetString(Result, @Buf[j], je-j);
+      SetString(Result, PAnsiChar(@Buf[j]), je-j);
   end;
 
 {$ifdef additional_routines}

+ 2 - 2
rtl/objpas/classes/stringl.inc

@@ -892,14 +892,14 @@ begin
     if Pointer(S) = Pointer(Value) then
       // Nothing to do
     else
-      SetString(S, @Value[StartPos], FuturePos - StartPos)
+      SetString(S, PChar(@Value[StartPos]), FuturePos - StartPos)
     end
   else
     if Pointer(S) = Pointer(Value) then
       System.Delete(S, FuturePos, High(FuturePos))
     else
       begin
-      SetString(S, @Value[StartPos], FuturePos - StartPos);
+      SetString(S, PChar(@Value[StartPos]), FuturePos - StartPos);
       Inc(FuturePos, Length(FLineBreak));
       end;
   P := FuturePos;

+ 1 - 1
rtl/objpas/sysutils/sysencoding.inc

@@ -575,7 +575,7 @@ end;
 
 function TMBCSEncoding.GetAnsiString(Bytes: PByte; ByteCount: Integer): ansistring;
 begin
-  SetString(Result, Pointer(Bytes), ByteCount);
+  SetString(Result, PAnsiChar(Bytes), ByteCount);
   SetCodePage(RawByteString(Result), GetCodePage, False);
   SetCodePage(RawByteString(Result), DefaultSystemCodePage, True);
 end;

+ 1 - 1
rtl/objpas/sysutils/syshelps.inc

@@ -444,7 +444,7 @@ begin
       end;
     Inc(PS);
     end;
-  SetString(Result,@Res[0],PD-@Res[0]);
+  SetString(Result,PTStringChar(@Res[0]),PD-@Res[0]);
 end;