+ is_dynamicstring

+ implement low/high for dynamic strings, resolves #15244 and #22936
+ basic support for $zerobasedstrings directive

git-svn-id: trunk@22933 -

.gitattributes

@@ -12958,6 +12958,7 @@ tests/webtbs/tw22876.pp svneol=native#text/pascal
 tests/webtbs/tw22878.pp svneol=native#text/plain
 tests/webtbs/tw2289.pp svneol=native#text/plain
 tests/webtbs/tw2291.pp svneol=native#text/plain
+tests/webtbs/tw22936.pp svneol=native#text/pascal
 tests/webtbs/tw2294.pp svneol=native#text/plain
 tests/webtbs/tw2296.pp svneol=native#text/plain
 tests/webtbs/tw22964.pp svneol=native#text/pascal

compiler/defutil.pas

@@ -189,6 +189,9 @@ interface
     {# true if p is an unicode string def }
     function is_unicodestring(p : tdef) : boolean;
 
+    {# true if p is an unicode/wide/ansistring string def }
+    function is_dynamicstring(p : tdef) : boolean;
+
     {# returns true if p is a wide or unicode string type }
     function is_wide_or_unicode_string(p : tdef) : boolean;
 
@@ -677,6 +680,13 @@ implementation
       end;
 
 
+    function is_dynamicstring(p: tdef): boolean;
+      begin
+         is_dynamicstring:=(p.typ=stringdef) and
+                        (tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring]);
+      end;
+
+
     { true if p is an wide string def }
     function is_wide_or_unicode_string(p : tdef) : boolean;
       begin

compiler/globtype.pas

@@ -136,7 +136,8 @@ interface
          { macpas specific}
          cs_external_var, cs_externally_visible,
          { jvm specific }
-         cs_check_var_copyout
+         cs_check_var_copyout,
+         cs_zerobasedstrings
        );
        tlocalswitches = set of tlocalswitch;
 

compiler/ncgld.pas

@@ -1,4 +1,4 @@
-{
+ {
     Copyright (c) 1998-2002 by Florian Klaempfl
 
     Generate assembler for nodes that handle loads and assignments which

compiler/ncgmem.pas

@@ -791,13 +791,15 @@ implementation
                   internalerror(2002032218);
               end;
 
-              { in ansistrings/widestrings S[1] is p<w>char(S)[0] !! }
               if is_ansistring(left.resultdef) then
                 offsetdec:=1
               else
                 offsetdec:=2;
               location.reference.alignment:=offsetdec;
-              dec(location.reference.offset,offsetdec);
+
+              { in ansistrings/widestrings S[1] is p<w>char(S)[0] }
+              if not(cs_zerobasedstrings in current_settings.localswitches) then
+                dec(location.reference.offset,offsetdec);
            end
          else if is_dynamic_array(left.resultdef) then
            begin

compiler/ninl.pas

@@ -2175,10 +2175,13 @@ implementation
                       begin
                         if inlinenumber=in_low_x then
                           begin
-                            result:=cordconstnode.create(0,u8inttype,false);
+                            if is_dynamicstring(left.resultdef) and
+                              not(cs_zerobasedstrings in current_settings.localswitches) then
+                              result:=cordconstnode.create(1,u8inttype,false)
+                            else
+                              result:=cordconstnode.create(0,u8inttype,false);
                           end
-                        else if not is_ansistring(left.resultdef) and
-                                not is_wide_or_unicode_string(left.resultdef) then
+                        else if not is_dynamicstring(left.resultdef) then
                           result:=cordconstnode.create(tstringdef(left.resultdef).len,u8inttype,true)
                       end;
                   end;
@@ -2918,9 +2921,15 @@ implementation
                               set_varstate(left,vs_read,[]);
                               result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry))
                             end
-                           else if is_ansistring(left.resultdef) or
-                                   is_wide_or_unicode_string(left.resultdef) then
-                             CGMessage(type_e_mismatch)
+                           else if is_dynamicstring(left.resultdef) then
+                              begin
+                                result:=cinlinenode.create(in_length_x,false,left);
+                                if cs_zerobasedstrings in current_settings.localswitches then
+                                  result:=caddnode.create(subn,result,cordconstnode.create(1,sinttype,false));
+                                { make sure the left node doesn't get disposed, since it's }
+                                { reused in the new node (JM)                              }
+                                left:=nil;
+                              end
                          end;
                      end;
                     else

compiler/nmem.pas

@@ -996,10 +996,12 @@ implementation
                   end
                 else
                  begin
-                   { indexed access to 0 element is only allowed for shortstrings }
+                   { indexed access to 0 element is only allowed for shortstrings or if
+                     zero based strings is turned on }
                    if (right.nodetype=ordconstn) and
                       (Tordconstnode(right).value.svalue=0) and
-                      not is_shortstring(left.resultdef) then
+                      not is_shortstring(left.resultdef) and
+                      not(cs_zerobasedstrings in current_settings.localswitches) then
                      CGMessage(cg_e_can_access_element_zero);
                    resultdef:=elementdef;
                  end;

compiler/scandir.pas

@@ -1469,6 +1469,11 @@ unit scandir;
       begin
       end;
 
+    procedure dir_zerobasesstrings;
+      begin
+        do_localswitch(cs_zerobasedstrings);
+      end;
+
 
 {****************************************************************************
                          Initialize Directives
@@ -1593,6 +1598,7 @@ unit scandir;
         AddDirective('Z1',directive_all, @dir_z1);
         AddDirective('Z2',directive_all, @dir_z2);
         AddDirective('Z4',directive_all, @dir_z4);
+        AddDirective('ZEROBASEDSTRINGS',directive_all, @dir_zerobasesstrings);
       end;
 
 end.

tests/webtbs/tw22936.pp

@@ -0,0 +1,31 @@
+program Project1;
+
+var
+  s: ansistring;
+  i : integer;
+
+begin
+  s := 'abc';
+
+  i:=1;
+
+  if low(s)<>i then
+    halt(1);
+
+  if high(s)<>3 then
+    halt(1);
+
+  i:=0;
+
+{$ZEROBASEDSTRINGS ON}
+  if low(s)<>i then
+    halt(1);
+
+  if high(s)<>2 then
+    halt(1);
+
+  if s[0]<>'a' then
+    halt(1);
+{$ZEROBASEDSTRINGS OFF}
+  writeln('ok');
+end.