Compile “length(string or array) = 0” as “pointer(string or array) = nil” without further check, unless really required.

Also handle length <> 0, > 0, < 0, >= 0, <= 0, assuming lengths are never negative.

compiler/nadd.pas

@@ -155,6 +155,8 @@ implementation
       cpuinfo,
       ppu;
 
+const
+    swap_relation: array [ltn..unequaln] of Tnodetype=(gtn, gten, ltn, lten, equaln, unequaln);
 
 {*****************************************************************************
                                 TADDNODE
@@ -480,37 +482,70 @@ implementation
           result:=true;
         end;
 
-      function IsLengthZero(n1,n2 : tnode) : Boolean;
-        begin
-          result:=is_inlinefunction(n1,in_length_x) and is_constintvalue(n2,0) and not(is_shortstring(tinlinenode(n1).left.resultdef));
-        end;
-
 
-      function TransformLengthZero(n1,n2 : tnode) : tnode;
+      function TryHandleLengthZero(L,R : tnode; op : tnodetype; var resn : tnode) : boolean;
         var
-          len : Tconstexprint;
-          lentype : tdef;
+          swapn : tnode;
         begin
-          if is_dynamic_array(tinlinenode(n1).left.resultdef) then
-            len:=-1
-          else
-            len:=0;
-          if is_widestring(tinlinenode(n1).left.resultdef) and (tf_winlikewidestring in target_info.flags) then
-            lentype:=u32inttype
-          else
-            lentype:=sizesinttype;
-          result:=caddnode.create_internal(orn,
-            caddnode.create_internal(equaln,ctypeconvnode.create_internal(tinlinenode(n1).left.getcopy,voidpointertype),
-                cpointerconstnode.create(0,voidpointertype)),
-              caddnode.create_internal(equaln,
-                ctypeconvnode.create_internal(
-                  cderefnode.create(
-                    caddnode.create_internal(subn,ctypeconvnode.create_internal(tinlinenode(n1).left.getcopy,voidpointertype),
-                      cordconstnode.create(lentype.size,lentype,false))
-                  ),lentype
-                ),
-              cordconstnode.create(len,lentype,false))
-            );
+          result:=false;
+          { Attempt to handle Length(S) = 0, <> 0, > 0, < 0, >= 0, <= 0. }
+          if not (op in [equaln,unequaln,ltn,lten,gtn,gten]) then
+            exit;
+          if not is_inlinefunction(L,in_length_x) then
+            if is_inlinefunction(R,in_length_x) then
+              begin
+                op:=swap_relation[op];
+                swapn:=L;
+                L:=R;
+                R:=swapn;
+              end
+            else
+              exit;
+          if not is_constintvalue(R,0) or is_shortstring(tinlinenode(L).left.resultdef) then
+            exit;
+
+          { Length = 0, <> 0, > 0, <= 0 are reduced to Length = 0. }
+          if op in [equaln,unequaln,gtn,lten] then
+            begin
+              { “pointer(L.left) = nil”. Steal L.left instead of getcopy, zero a bit later. }
+              resn:=caddnode.create_internal(equaln,ctypeconvnode.create_internal(tinlinenode(L).left,voidpointertype),
+                 cpointerconstnode.create(0,voidpointertype));
+
+              { COM widestrings have 32-bit lengths, and can explicitly have 0 while being non-nil. }
+              if is_widestring(tinlinenode(L).left.resultdef) and (tf_winlikewidestring in target_info.flags) then
+                { Expand to “(pointer(L.left) = nil) or (PUint32(L.left)[-1] = 0)”. }
+                resn:=caddnode.create_internal(orn,
+                    resn,
+                    caddnode.create_internal(equaln,
+                      ctypeconvnode.create_internal(
+                        cderefnode.create(
+                          caddnode.create_internal(subn,ctypeconvnode.create_internal(tinlinenode(L).left.getcopy,voidpointertype),
+                            cordconstnode.create(sizeof(uint32),ptruinttype,false))
+                        ),u32inttype
+                      ),
+                    cordconstnode.create(0,u32inttype,false))
+                  );
+              tinlinenode(L).left:=nil; { Was stolen inside resn, and no longer of interest. }
+
+              { resn now checks for Length = 0. For Length <> 0, invert. }
+              if op in [unequaln,gtn] then
+                resn:=cnotnode.create(resn);
+              exit(true);
+            end;
+
+          { Warn on Length < 0 and Length >= 0. }
+          if not (tnf_pass1_done in L.transientflags) then { ...Only once. }
+            if op=gten then
+              Message(type_w_comparison_always_true)
+            else
+              Message(type_w_comparison_always_false);
+
+          { Length < 0 is always false, Length >= 0 is always true. }
+          if not might_have_sideeffects(tinlinenode(L).left) then { Could somehow remove the check but keep the F() even in Length(F()) >= 0... }
+            begin
+              resn:=cordconstnode.create(ord(op=gten),resultdef,true);
+              exit(true);
+            end;
         end;
 
 
@@ -1733,8 +1768,8 @@ implementation
                     end;
                   end
 {$ifndef jvm}
-                else if (nodetype=equaln) and MatchAndTransformNodesCommutative(left,right,@IsLengthZero,@TransformLengthZero,Result) then
-                   exit
+                else if TryHandleLengthZero(left,right,nodetype,Result) then
+                  exit
 {$endif jvm}
                    ;
               end;
@@ -3404,8 +3439,6 @@ implementation
 
 
     function taddnode.first_addstring: tnode;
-      const
-        swap_relation: array [ltn..unequaln] of Tnodetype=(gtn, gten, ltn, lten, equaln, unequaln);
       var
         p: tnode;
         newstatement : tstatementnode;

tests/test/tlenzero.pp

@@ -0,0 +1,78 @@
+{ %opt=-O2 }
+{$mode objfpc} {$longstrings on}
+var
+	somethingFailed: boolean = false;
+
+	procedure Expect(got, expected: boolean; const what: string);
+	begin
+		if got <> expected then
+		begin
+			writeln(what, ' is ', got, ', expected ', expected, '.');
+			somethingFailed := true;
+		end;
+	end;
+
+var
+	s: string;
+	sideeffectOk: boolean;
+
+	function GetS: string; noinline;
+	begin
+		result := 'a';
+		sideeffectOk := true;
+	end;
+
+{$ifdef windows}
+	function SysAllocStringLen(psz: pointer; len: dword): pointer; stdcall; external 'oleaut32.dll' name 'SysAllocStringLen';
+var
+	ws: widestring;
+{$endif}
+
+begin
+	s := ''; if random(0) = 1 then s := 'a';
+	Expect(length(s) > 0, false, 'length('''') > 0');
+	Expect(length(s) <= 0, true, 'length('''') <= 0');
+	Expect(length(s) = 0, true, 'length('''') = 0');
+	Expect(length(s) <> 0, false, 'length('''') <> 0');
+	Expect(0 < length(s), false, '0 < length('''')');
+	Expect(0 >= length(s), true, '0 >= length('''')');
+	Expect(0 = length(s), true, '0 = length('''')');
+	Expect(0 <> length(s), false, '0 <> length('''')');
+
+	if random(0) = 0 then s := 'a';
+	Expect(length(s) > 0, true, 'length(''a'') > 0');
+	Expect(length(s) <= 0, false, 'length(''a'') <= 0');
+	Expect(length(s) = 0, false, 'length(''a'') = 0');
+	Expect(length(s) <> 0, true, 'length(''a'') <> 0');
+	Expect(0 < length(s), true, '0 < length(''a'')');
+	Expect(0 >= length(s), false, '0 >= length(''a'')');
+	Expect(0 = length(s), false, '0 = length(''a'')');
+	Expect(0 <> length(s), true, '0 <> length(''a'')');
+
+	Expect(length(s) >= 0, true, 'length(''a'') >= 0');
+	Expect(0 <= length(s), true, '0 <= length(''a'')');
+	Expect(length(s) < 0, false, 'length(''a'') < 0');
+	Expect(0 > length(s), false, '0 > length(''a'')');
+
+	Expect(IsConstValue(length(s) > 0), false, 'IsConstValue(length(''a'') > 0)');
+	Expect(IsConstValue(length(s) >= 0), true, 'IsConstValue(length(''a'') >= 0)');
+	Expect(IsConstValue(length(s) < 0), true, 'IsConstValue(length(''a'') < 0)');
+	Expect(IsConstValue(0 < length(s)), false, 'IsConstValue(0 < length(''a''))');
+	Expect(IsConstValue(0 <= length(s)), true, 'IsConstValue(0 <= length(''a''))');
+	Expect(IsConstValue(0 > length(s)), true, 'IsConstValue(0 > length(''a''))');
+
+	sideeffectOk := false;
+	if (Length(GetS) < 0) or not sideeffectOk then
+	begin
+		writeln('Length(GetS) is either < 0 or, more likely, ignored the side effect of GetS.');
+		somethingFailed := true;
+	end;
+
+{$ifdef windows}
+	ws := '';
+	pointer(ws) := SysAllocStringLen(nil, 0);
+	Expect(length(ws) = 0, true, 'length(allocated but empty COM widestring) = 0');
+{$endif}
+
+	if somethingFailed then halt(1);
+end.