o patch by Michael Denisenko, resolves #14734:

  * fixes memory leaks in case of string code
  * replace usage of strcmp
  * improved tests

git-svn-id: trunk@13830 -

compiler/ncon.pas

@@ -192,6 +192,7 @@ interface
     { some helper routines }
     function get_ordinal_value(p : tnode) : TConstExprInt;
     function get_string_value(p : tnode; is_wide : boolean = false) : TConstString;
+    function compare_strings(str1, str2: pchar) : longint;
     function is_constresourcestringnode(p : tnode) : boolean;
     function is_emptyset(p : tnode):boolean;
     function genconstsymtree(p : tconstsym) : tnode;
@@ -254,11 +255,12 @@ implementation
                 if (not is_wide) then
                   begin
                     if ordValRecord.signed then
-                      stringVal := char(ordValRecord.svalue) + ''#0
+                      stringVal := char(ordValRecord.svalue)
                     else
-                      stringVal := char(ordValRecord.uvalue) + ''#0;
-                    getmem(pCharVal, length(stringVal));
+                      stringVal := char(ordValRecord.uvalue);
+                    getmem(pCharVal, length(stringVal) + 1);
                     strpcopy(pCharVal, stringVal);
+                    pCharVal[length(stringVal)] := #0;
                     get_string_value := pCharVal;
                   end
                 else
@@ -317,6 +319,25 @@ implementation
           end;
       end;
 
+
+    function compare_strings(str1, str2: pchar) : longint;
+      var
+        minlen, len1, len2: integer;
+      begin
+        len1 := length(str1);
+        len2 := length(str2);
+        if len1 < len2 then
+          minlen := len1
+        else
+          minlen := len2;
+
+        minlen := comparebyte(str1^, str2^, minlen);
+        if minlen = 0 then
+          minlen := len1 - len2;
+        Result := minlen;
+      end;
+
+
     function is_constresourcestringnode(p : tnode) : boolean;
       begin
         is_constresourcestringnode:=(p.nodetype=loadn) and

compiler/nset.pas

@@ -766,7 +766,7 @@ implementation
               condit := caddnode.create(
                 equaln, left.getcopy, cstringconstnode.createstr(labtree^._low_str));
 
-              if (strcomp(labtree^._low_str, labtree^._high_str) <> 0) then
+              if (compare_strings(labtree^._low_str, labtree^._high_str) <> 0) then
                 begin
                   condit.nodetype := gten;
                   condit := caddnode.create(
@@ -791,10 +791,17 @@ implementation
          init_block:=nil;
          expectloc:=LOC_VOID;
 
+         { evalutes the case expression }
+         firstpass(left);
+         set_varstate(left,vs_read,[vsf_must_be_valid]);
+         if codegenerror then
+           exit;
+
          { Load caseexpr into temp var if complex. }
          { No need to do this for ordinal, because }
          { in that case caseexpr is generated once }
-         if (labels^.label_type = ltConstString) and (not valid_for_addr(left, false)) then
+         if (labels^.label_type = ltConstString) and (not valid_for_addr(left, false)) and
+           (blocks.count > 0) then
            begin
              init_block := internalstatements(stmt);
              tempcaseexpr :=
@@ -811,12 +818,6 @@ implementation
              typecheckpass(left);
            end;
 
-         { evalutes the case expression }
-         firstpass(left);
-         set_varstate(left,vs_read,[vsf_must_be_valid]);
-         if codegenerror then
-           exit;
-
          { first case }
          for i:=0 to blocks.count-1 do
            firstpass(pcaseblock(blocks[i])^.statement);
@@ -1065,7 +1066,7 @@ implementation
           if (str_type in [cst_widestring, cst_unicodestring]) then
             result := comparewidestrings(pcompilerwidestring(l), pcompilerwidestring(h))
           else
-            result := strcomp(l, h);
+            result := compare_strings(l, h);
         end;
 
       var

compiler/pstatmnt.pas

@@ -183,8 +183,8 @@ implementation
                end;
              hl1:=0;
              hl2:=0;
-             sl1:='';
-             sl2:='';
+             sl1:=nil;
+             sl2:=nil;
              if (p.nodetype=rangen) then
                begin
                  { type check for string case statements }
@@ -197,7 +197,7 @@ implementation
                    if (
                      (is_wide_or_unicode_string(casedef) and (
                        comparewidestrings(pcompilerwidestring(sl1), pcompilerwidestring(sl2)) > 0)) or
-                     ((not is_wide_or_unicode_string(casedef)) and (strcomp(sl1, sl2) > 0))) then
+                     ((not is_wide_or_unicode_string(casedef)) and (compare_strings(sl1, sl2) > 0))) then
                      CGMessage(parser_e_case_lower_less_than_upper_bound);
                  end
                  { type checking for ordinal case statements }
@@ -245,6 +245,29 @@ implementation
                    end;
                end;
              p.free;
+             if caseofstring then
+               begin
+                 if is_wide_or_unicode_string(casedef) then
+                   begin
+                     if assigned(sl1) then
+                       donewidestring(pcompilerwidestring(sl1));
+                     if assigned(sl2) then
+                       donewidestring(pcompilerwidestring(sl2));
+                   end
+                 else
+                   begin
+                     if assigned(sl1) then
+                       begin
+                         freemem(sl1);
+                         sl1 := nil;
+                       end;
+                     if assigned(sl2) then
+                       begin
+                         freemem(sl2);
+                         sl2 := nil;
+                       end;
+                   end;
+               end;
              if token=_COMMA then
                consume(_COMMA)
              else

tests/test/tcase15.pp

@@ -3,9 +3,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase16.pp

@@ -3,9 +3,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase17.pp

@@ -3,9 +3,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase19.pp

@@ -5,9 +5,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase20.pp

@@ -5,9 +5,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase21.pp

@@ -5,9 +5,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase22.pp

@@ -3,9 +3,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase23.pp

@@ -5,9 +5,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase24.pp

@@ -3,9 +3,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase25.pp

@@ -3,9 +3,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase26.pp

@@ -5,9 +5,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase27.pp

@@ -5,9 +5,9 @@
 {$H+}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase31.pp

@@ -3,9 +3,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase32.pp

@@ -3,9 +3,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase33.pp

@@ -3,9 +3,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase35.pp

@@ -5,9 +5,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase36.pp

@@ -5,9 +5,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase37.pp

@@ -5,9 +5,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase38.pp

@@ -3,9 +3,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase39.pp

@@ -5,9 +5,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase40.pp

@@ -3,9 +3,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase41.pp

@@ -3,9 +3,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase42.pp

@@ -5,9 +5,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase43.pp

@@ -5,9 +5,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin

tests/test/tcase44.pp

@@ -4,9 +4,9 @@
 {$H-}
 var
   my_str: string;
-  my_str_wide: string;
-  my_str_ansi: string;
-  my_str_uni: string;
+  my_str_wide: widestring;
+  my_str_ansi: ansistring;
+  my_str_uni: unicodestring;
   i: integer;
 
 begin