o patch by Michael Denisenko, resolves #14734:

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


git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@13830 3ad0048d-3df7-0310-abae-a5850022a9f2

28 files changed, 135 insertions, 90 deletions

diff --git a/compiler/ncon.pas b/compiler/ncon.pas
index 4fc6698ff5..9db3b6fe21 100644
--- a/compiler/ncon.pas
+++ b/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
diff --git a/compiler/nset.pas b/compiler/nset.pas
index f9f95b54fb..59fa96e13e 100644
--- a/compiler/nset.pas
+++ b/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
diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas
index 411d881474..0d03701e2a 100644
--- a/compiler/pstatmnt.pas
+++ b/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
diff --git a/tests/test/tcase15.pp b/tests/test/tcase15.pp
index 14b31319c6..2a5f9f469a 100644
--- a/tests/test/tcase15.pp
+++ b/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
diff --git a/tests/test/tcase16.pp b/tests/test/tcase16.pp
index 8f35cd07e6..2e212972ce 100644
--- a/tests/test/tcase16.pp
+++ b/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
diff --git a/tests/test/tcase17.pp b/tests/test/tcase17.pp
index a3c854e9f5..998b19d04d 100644
--- a/tests/test/tcase17.pp
+++ b/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
diff --git a/tests/test/tcase19.pp b/tests/test/tcase19.pp
index 8e3abb95ce..8da9b363d5 100644
--- a/tests/test/tcase19.pp
+++ b/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
diff --git a/tests/test/tcase20.pp b/tests/test/tcase20.pp
index dd5b98440f..d4a7f46535 100644
--- a/tests/test/tcase20.pp
+++ b/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
diff --git a/tests/test/tcase21.pp b/tests/test/tcase21.pp
index 4d69a67d3c..c729932554 100644
--- a/tests/test/tcase21.pp
+++ b/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
diff --git a/tests/test/tcase22.pp b/tests/test/tcase22.pp
index 9872588b8a..75558bd82d 100644
--- a/tests/test/tcase22.pp
+++ b/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
diff --git a/tests/test/tcase23.pp b/tests/test/tcase23.pp
index 7e080d54eb..c86bdbe483 100644
--- a/tests/test/tcase23.pp
+++ b/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
diff --git a/tests/test/tcase24.pp b/tests/test/tcase24.pp
index 50b0b52506..d9cd87a833 100644
--- a/tests/test/tcase24.pp
+++ b/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
diff --git a/tests/test/tcase25.pp b/tests/test/tcase25.pp
index 2af7c9072e..113b360b24 100644
--- a/tests/test/tcase25.pp
+++ b/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
diff --git a/tests/test/tcase26.pp b/tests/test/tcase26.pp
index f885e6f069..49a40c91dc 100644
--- a/tests/test/tcase26.pp
+++ b/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
diff --git a/tests/test/tcase27.pp b/tests/test/tcase27.pp
index 307433f311..7a5af68416 100644
--- a/tests/test/tcase27.pp
+++ b/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
diff --git a/tests/test/tcase31.pp b/tests/test/tcase31.pp
index dab14d2018..f285f27690 100644
--- a/tests/test/tcase31.pp
+++ b/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
diff --git a/tests/test/tcase32.pp b/tests/test/tcase32.pp
index 26bf5672bd..c4ffe2c78c 100644
--- a/tests/test/tcase32.pp
+++ b/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
diff --git a/tests/test/tcase33.pp b/tests/test/tcase33.pp
index f801a9d1f2..db8e50c45f 100644
--- a/tests/test/tcase33.pp
+++ b/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
diff --git a/tests/test/tcase35.pp b/tests/test/tcase35.pp
index e8be55f7d3..96983d4d0b 100644
--- a/tests/test/tcase35.pp
+++ b/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
diff --git a/tests/test/tcase36.pp b/tests/test/tcase36.pp
index 309a1e0b21..5ecdf5a843 100644
--- a/tests/test/tcase36.pp
+++ b/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
diff --git a/tests/test/tcase37.pp b/tests/test/tcase37.pp
index c6e548f921..fc494ab88d 100644
--- a/tests/test/tcase37.pp
+++ b/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
diff --git a/tests/test/tcase38.pp b/tests/test/tcase38.pp
index bdcfa5b491..d7eef9520f 100644
--- a/tests/test/tcase38.pp
+++ b/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
diff --git a/tests/test/tcase39.pp b/tests/test/tcase39.pp
index 3ff3256c76..01f0816d2b 100644
--- a/tests/test/tcase39.pp
+++ b/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
diff --git a/tests/test/tcase40.pp b/tests/test/tcase40.pp
index 393fd71a91..3297e63db8 100644
--- a/tests/test/tcase40.pp
+++ b/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
diff --git a/tests/test/tcase41.pp b/tests/test/tcase41.pp
index c4c0b2ec4d..56c37f7923 100644
--- a/tests/test/tcase41.pp
+++ b/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
diff --git a/tests/test/tcase42.pp b/tests/test/tcase42.pp
index 8797e69b92..f76a4bb7a8 100644
--- a/tests/test/tcase42.pp
+++ b/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
diff --git a/tests/test/tcase43.pp b/tests/test/tcase43.pp
index 9513fef784..b26ff06d6c 100644
--- a/tests/test/tcase43.pp
+++ b/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
diff --git a/tests/test/tcase44.pp b/tests/test/tcase44.pp
index 78a16e6527..bf245c3489 100644
--- a/tests/test/tcase44.pp
+++ b/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