+ support str(<boolean>,...), boolean is an enumeration type

* don't run pass_1 on str or val calls in generic method/procedure definitions, resolves #18420

git-svn-id: trunk@16849 -

.gitattributes

@@ -9330,6 +9330,7 @@ tests/test/tenum2.pp svneol=native#text/plain
 tests/test/tenum3.pp svneol=native#text/plain
 tests/test/tenum4.pp svneol=native#text/plain
 tests/test/tenum5.pp svneol=native#text/plain
+tests/test/tenum6.pp svneol=native#text/pascal
 tests/test/tenumerators1.pp svneol=native#text/pascal
 tests/test/terecs1.pp svneol=native#text/pascal
 tests/test/terecs2.pp svneol=native#text/pascal
@@ -10954,6 +10955,7 @@ tests/webtbs/tw18222.pp svneol=native#text/pascal
 tests/webtbs/tw1825.pp svneol=native#text/plain
 tests/webtbs/tw18266.pp svneol=native#text/plain
 tests/webtbs/tw18334.pp svneol=native#text/plain
+tests/webtbs/tw18420.pp svneol=native#text/pascal
 tests/webtbs/tw18443.pp svneol=native#text/pascal
 tests/webtbs/tw1850.pp svneol=native#text/plain
 tests/webtbs/tw1851.pp svneol=native#text/plain

compiler/ninl.pas

@@ -150,15 +150,6 @@ implementation
       begin
         result := cerrornode.create;
 
-        { make sure we got at least two parameters (if we got only one, }
-        { this parameter may not be encapsulated in a callparan)        }
-        if not assigned(left) or
-           (left.nodetype <> callparan) then
-          begin
-            CGMessage1(parser_e_wrong_parameter_size,'Str');
-            exit;
-          end;
-
         { get destination string }
         dest := tcallparanode(left);
 
@@ -176,6 +167,16 @@ implementation
             exit;
           end;
 
+        { in case we are in a generic definition, we cannot
+          do all checks, the parameters might be type parameters }
+        if df_generic in current_procinfo.procdef.defoptions then
+          begin
+            result.Free;
+            result:=nil;
+            resultdef:=voidtype;
+            exit;
+          end;
+
         is_real:=(source.resultdef.typ = floatdef) or is_currency(source.resultdef);
         is_enum:=source.left.resultdef.typ=enumdef;
 
@@ -313,6 +314,8 @@ implementation
             scurrency,
             s64bit:
               procname := procname + 'int64';
+            pasbool,bool8bit,bool16bit,bool32bit,bool64bit:
+              procname := procname + 'bool';
 {$endif}
             else
               procname := procname + 'sint';
@@ -1143,6 +1146,16 @@ implementation
            exit;
          end;
 
+         { in case we are in a generic definition, we cannot
+           do all checks, the parameters might be type parameters }
+         if df_generic in current_procinfo.procdef.defoptions then
+           begin
+             result.Free;
+             result:=nil;
+             resultdef:=voidtype;
+             exit;
+           end;
+
         { reverse parameters for easier processing }
         left := reverseparameters(tcallparanode(left));
 

rtl/inc/astrings.inc

@@ -428,11 +428,11 @@ begin
       if (arr[0]=#0) Then
         i := 0
       else
-      begin  
+      begin
         i:=IndexChar(arr,high(arr)+1,#0);
         if i = -1 then
           i := high(arr)+1;
-      end;    
+      end;
     end
   else
     i := high(arr)+1;
@@ -938,6 +938,16 @@ begin
   s:=ss;
 end;
 
+
+procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring);[public,alias:'FPC_ANSISTR_BOOL'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
+var
+  ss:shortstring;
+begin
+  fpc_shortstr_bool(b,len,ss);
+  s:=ss;
+end;
+
+
 function fpc_val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_ANSISTR']; compilerproc;
 
 begin

rtl/inc/compproc.inc

@@ -102,6 +102,7 @@ procedure fpc_shortstr_uint(v : valuint;len : SizeInt;out s : shortstring); comp
 procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : shortstring); compilerproc;
 {$endif}
 procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);compilerproc;
+procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);compilerproc;
 procedure fpc_ShortStr_Currency(c : currency; len,f : SizeInt; out s : shortstring); compilerproc;
 
 procedure fpc_chararray_sint(v : valsint;len : SizeInt;out a : array of char); compilerproc;
@@ -113,6 +114,7 @@ procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; out S : AnsiString); compi
 procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring); compilerproc;
 {$endif}
 procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring); compilerproc;
+procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring); compilerproc;
 {$ifdef FPC_HAS_STR_CURRENCY}
 procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring); compilerproc;
 {$endif FPC_HAS_STR_CURRENCY}
@@ -156,6 +158,7 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
     procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString); compilerproc;
     {$endif}
     procedure fpc_widestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:widestring);compilerproc;
+    procedure fpc_widestr_bool(b : boolean;len:sizeint;out s:widestring);compilerproc;
     {$ifdef FPC_HAS_STR_CURRENCY}
     procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
     {$endif FPC_HAS_STR_CURRENCY}
@@ -165,6 +168,7 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
     procedure fpc_UnicodeStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : UnicodeString); compilerproc;
     {$endif}
     procedure fpc_unicodestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:unicodestring);compilerproc;
+    procedure fpc_unicodestr_bool(b : boolean;len:sizeint;out s:unicodestring);compilerproc;
     {$ifdef FPC_HAS_STR_CURRENCY}
     procedure fpc_UnicodeStr_Currency(c : Currency;len,fr : SizeInt;out s : UnicodeString);compilerproc;
     {$endif FPC_HAS_STR_CURRENCY}
@@ -175,6 +179,7 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
 procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;out a : array of char); compilerproc;
 {$endif}
 procedure fpc_chararray_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out a : array of char);compilerproc;
+procedure fpc_chararray_bool(b : boolean;len:sizeint;out a : array of char);compilerproc;
 {$ifdef FPC_HAS_STR_CURRENCY}
 procedure fpc_chararray_Currency(c : Currency;len,fr : SizeInt;out a : array of char);compilerproc;
 {$endif FPC_HAS_STR_CURRENCY}

rtl/inc/sstrings.inc

@@ -471,7 +471,7 @@ begin
 
   enum_o2s:=Penum_ord_to_string(ord2strindex);
   { depending on the type of table in ord2strindex retrieve the data }
-  if (enum_o2s^.o=lookup) then 
+  if (enum_o2s^.o=lookup) then
     begin
       { direct lookup table }
       header:=Penum_typeinfo(typinfo);
@@ -483,7 +483,7 @@ begin
         {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} 1 {$else} sizeof(pointer) {$endif}));
       with (body^.inner) do
         begin
-          { Bounds check for the ordinal value for this enum }     
+          { Bounds check for the ordinal value for this enum }
           if (ordinal<minvalue) or (ordinal>maxvalue) then
             exit;
           { make the ordinal index for lookup zero-based }
@@ -548,6 +548,20 @@ end;
 procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);external name 'FPC_SHORTSTR_ENUM';
 
 
+procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);[public,alias:'FPC_SHORTSTR_BOOL'];compilerproc;
+begin
+  if b then
+    s:='TRUE'
+  else
+    s:='FALSE';
+  if length(s)<len then
+    s:=space(len-length(s))+s;
+end;
+
+{ also define alias for internal use in the system unit }
+procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);external name 'FPC_SHORTSTR_BOOL';
+
+
 procedure fpc_shortstr_currency(c : currency; len,f : SizeInt; out s : shortstring);[public,alias:'FPC_SHORTSTR_CURRENCY']; compilerproc;
 const
   MinLen = 8; { Minimal string length in scientific format }
@@ -639,7 +653,7 @@ begin
               k:=1
             else
               k:=0;
-            end; 
+            end;
           Inc(i);
           if i>tlen  then
             break;
@@ -664,7 +678,7 @@ begin
 			  inc(reslen);
 			  inc(tlen);
 			end;
-		end;		  
+		end;		
     end;
   { preparing result string }
   if reslen<len then
@@ -833,6 +847,20 @@ begin
 end;
 
 
+procedure fpc_chararray_bool(b : boolean;len:sizeint;out a : array of char);compilerproc;
+var
+  ss : shortstring;
+  maxlen : SizeInt;
+begin
+  fpc_shortstr_bool(b,len,ss);
+  if length(ss)<high(a)+1 then
+    maxlen:=length(ss)
+  else
+    maxlen:=high(a)+1;
+  move(ss[1],pchar(@a)^,maxlen);
+end;
+
+
 {$ifdef FPC_HAS_STR_CURRENCY}
 procedure fpc_chararray_Currency(c : Currency;len,fr : SizeInt;out a : array of char);compilerproc;
 var
@@ -859,7 +887,7 @@ begin
   code:=1;
   negativ:=false;
   base:=10;
-  if length(s)=0 then 
+  if length(s)=0 then
     begin
       InitVal:=code;
       Exit;
@@ -1262,17 +1290,17 @@ end;
 {$endif}
 
 function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_SHORTSTR']; compilerproc;
-    
+
     function string_compare(const s1,s2:shortstring):sizeint;
-    
+
     {We cannot use the > and < operators to compare a string here, because we if the string is
      not found in the enum, we need to return the position of error in "code". Code equals the
      highest matching character of all string compares, which is only known inside the string
      comparison.}
-    
+
     var i,l:byte;
         c1,c2:char;
-    
+
     begin
       l:=length(s1);
       if length(s1)>length(s2) then

rtl/inc/ustrings.inc

@@ -1812,6 +1812,15 @@ begin
   s:=ss;
 end;
 
+procedure fpc_unicodestr_bool(b : boolean;len:sizeint;out s:unicodestring);compilerproc;
+
+var ss:shortstring;
+
+begin
+  fpc_shortstr_bool(b,len,ss);
+  s:=ss;
+end;
+
 {$ifdef FPC_HAS_STR_CURRENCY}
 procedure fpc_UnicodeStr_Currency(c : Currency;len,fr : SizeInt;out s : UnicodeString);compilerproc;
 var

rtl/inc/wstrings.inc

@@ -1138,6 +1138,15 @@ begin
   s:=ss;
 end;
 
+procedure fpc_widestr_bool(b : boolean;len:sizeint;out s:widestring);compilerproc;
+
+var ss:shortstring;
+
+begin
+  fpc_shortstr_bool(b,len,ss);
+  s:=ss;
+end;
+
 {$ifdef FPC_HAS_STR_CURRENCY}
 procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
 var

tests/test/tenum6.pp

@@ -0,0 +1,37 @@
+var
+  b : boolean;
+  b8 : ByteBool;
+  b16 : WordBool;
+  b32 : LongBool;
+  b64 : QWordBool;
+  s : string;
+
+begin
+  b:=false;
+  str(b,s);
+  if s<>'FALSE' then
+    halt(1);
+
+  b8:=false;
+  str(b8,s);
+  if s<>'FALSE' then
+    halt(1);
+
+  b16:=false;
+  str(b16,s);
+  if s<>'FALSE' then
+    halt(1);
+
+  b32:=false;
+  str(b32,s);
+  if s<>'FALSE' then
+    halt(1);
+
+  b64:=false;
+  str(b64,s);
+  if s<>'FALSE' then
+    halt(1);
+
+  writeln('ok');
+end.
+

tests/webtbs/tw18420.pp

@@ -0,0 +1,25 @@
+unit tw18420;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  generic TGC<T> = class
+    Value: T;
+    procedure M;
+  end;
+
+  TGI = specialize TGC<Integer>;
+
+implementation
+
+procedure TGC.M;
+var
+  s: String;
+begin
+  Str(Value,s);
+  Val(s,Value);
+end;
+
+end.