--- p/predef.c Fri Mar 24 02:47:15 2006 +++ p/predef.c Thu Aug 3 21:05:22 2006 @@ -94,6 +94,7 @@ static tree int_range_type (tree, int); static int direct_access_warning (tree); static tree get_read_flags (int); +static unsigned HOST_WIDE_INT get_string_length_plus_1 (tree, int); static tree actual_set_parameters (tree, int); static tree build_read (int, tree, const char *); static tree string_par (tree *); @@ -464,6 +465,28 @@ return build_int_2 (flags, 0); } +/* Return the string length (modulo padding) + 1 if known, 0 otherwise. (We need an unsigned type here.) */ +static unsigned HOST_WIDE_INT +get_string_length_plus_1 (tree string, int nopad) +{ + unsigned HOST_WIDE_INT l; + const char *p; + tree t = PASCAL_STRING_LENGTH (string); + if (TREE_CODE (t) != INTEGER_CST) + return 0; + l = TREE_INT_CST_LOW (t); + if (nopad) + return l + 1; + if (TREE_CODE (string) == INTEGER_CST && TREE_CODE (TREE_TYPE (string)) == CHAR_TYPE) + return TREE_INT_CST_LOW (string) == ' ' ? 1 : 2; + if (TREE_CODE (string) != STRING_CST) + return 0; + p = TREE_STRING_POINTER (string); + while (l > 0 && p[l - 1] == ' ') + l--; + return l + 1; +} + /* Make sure that a string can be accessed multiple times (usually for the length and contents). Note that the string does not need to be an lvalue. (note `function: PString' vs. `function: String') */ @@ -2589,6 +2612,9 @@ case '=': case '<': { + int nopad = r_num == p_EQ || r_num == p_LT; + const char *warning_str = NULL; + if (swapargs) { TREE_VALUE (apar) = val2; @@ -2596,7 +2622,19 @@ val = TREE_VALUE (apar); } - if (IS_STRING_CST (val) && IS_STRING_CST (val2)) + if (r_num == p_EQ || r_num == '=') + { + unsigned HOST_WIDE_INT l1 = get_string_length_plus_1 (val, nopad), l2 = get_string_length_plus_1 (val2, nopad); + tree c1 = PASCAL_TYPE_STRING (TREE_TYPE (val )) ? PASCAL_STRING_CAPACITY (val ) : PASCAL_STRING_LENGTH (val ); + tree c2 = PASCAL_TYPE_STRING (TREE_TYPE (val2)) ? PASCAL_STRING_CAPACITY (val2) : PASCAL_STRING_LENGTH (val2); + if (l1 > 0 && l2 > 0 && l1 != l2) + warning_str = "string comparison is always %s due to different length of fixed-size strings"; + else if ((l2 > 0 && TREE_CODE (c1) == INTEGER_CST && TREE_INT_CST_LOW (c1) < l2 - 1) || + (l1 > 0 && TREE_CODE (c2) == INTEGER_CST && TREE_INT_CST_LOW (c2) < l1 - 1)) + warning_str = "string comparison is always %s because the capacity of one string is smaller than the length of the fixed-size string"; + } + + if (!warning_str && IS_STRING_CST (val) && IS_STRING_CST (val2)) { const char *p1, *p2; unsigned int l1, l2, r; @@ -2639,7 +2677,7 @@ } /* Optimize non-padding comparisons against the constant empty string */ - if (r_num == p_EQ || r_num == p_LT) + if (!warning_str && nopad) { tree comp_empty = NULL; if (IS_CONSTANT_EMPTY_STRING (val)) @@ -2651,16 +2689,9 @@ else if (IS_CONSTANT_EMPTY_STRING (val2)) { if (r_num == p_LT) /* s < '' is impossible */ - { - if (invert_result) - warning ("`>=' comparison against the empty string is always `True'."); - else - warning ("`<' comparison against the empty string is always `False'."); - if (TREE_SIDE_EFFECTS (val)) - warning (" Operand with side-effects is not evaluated."); - return invert_result ? boolean_true_node : boolean_false_node; - } - comp_empty = val; + warning_str = "`>=' comparison against the empty string is always %s."; + else + comp_empty = val; } if (comp_empty) { @@ -2672,6 +2703,14 @@ errstr = "argument to `%s' must be a string or char"; break; } + } + + if (warning_str) + { + warning (warning_str, invert_result ? "true" : "false"); + if (TREE_SIDE_EFFECTS (val) || TREE_SIDE_EFFECTS (val2)) + warning (" Operand with side-effects is not evaluated."); + return invert_result ? boolean_true_node : boolean_false_node; } break; } --- p/test/dave7a.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7a.pas Thu Aug 3 20:20:58 2006 @@ -0,0 +1,10 @@ +program comp (output); + + var s : packed array [1..4] of char; + +begin + s := 'abc'; + if s = 'abc' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7b.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7b.pas Thu Aug 3 20:20:58 2006 @@ -0,0 +1,12 @@ +program comp (output); + + var s : packed array [1..4] of char; + t : packed array [1..3] of char; + +begin + s := 'abc'; + t := 'abc'; + if s <> t { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7c.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7c.pas Thu Aug 3 20:23:12 2006 @@ -0,0 +1,10 @@ +program comp (output); + + var s : packed array [1..4] of char; + +begin + s := 'abc'; + if s = 'abcde' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7d.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7d.pas Thu Aug 3 20:23:08 2006 @@ -0,0 +1,12 @@ +{$extended-pascal} + +program comp (output); + + var s : packed array [1..4] of char; + +begin + s := 'abc'; + if s = 'abcde' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7e.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7e.pas Thu Aug 3 20:26:15 2006 @@ -0,0 +1,10 @@ +program comp (output); + + var s : packed array [1..4] of char; + +begin + s := 'abc'; + if s = 'abcd ' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7f.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7f.pas Thu Aug 3 20:25:43 2006 @@ -0,0 +1,12 @@ +{$extended-pascal} + +program comp (output); + + var s : packed array [1..4] of char; + +begin + s := 'abc'; + if s = 'abcd ' + then writeln ('failed') + else writeln ('OK') +end. --- p/test/dave7g.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7g.pas Thu Aug 3 20:26:47 2006 @@ -0,0 +1,10 @@ +program comp (output); + + var c : Char; + +begin + c := 'a'; + if c = '' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7h.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7h.pas Thu Aug 3 20:27:04 2006 @@ -0,0 +1,12 @@ +{$extended-pascal} + +program comp (output); + + var c : Char; + +begin + c := 'a'; + if c = '' + then writeln ('failed') + else writeln ('OK') +end. --- p/test/dave7i.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7i.pas Thu Aug 3 20:27:39 2006 @@ -0,0 +1,10 @@ +program comp (output); + + var c : Char; + +begin + c := 'a'; + if c = 'ab' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7j.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7j.pas Thu Aug 3 20:27:49 2006 @@ -0,0 +1,12 @@ +{$extended-pascal} + +program comp (output); + + var c : Char; + +begin + c := 'a'; + if c = 'ab' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7k.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7k.pas Thu Aug 3 20:29:15 2006 @@ -0,0 +1,7 @@ +program comp (output); + +begin + if '' = ' ' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7l.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7l.pas Thu Aug 3 20:29:52 2006 @@ -0,0 +1,9 @@ +{$extended-pascal} + +program comp (output); + +begin + if '' = ' ' + then writeln ('OK') + else writeln ('failed') +end. --- p/test/dave7m.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7m.pas Thu Aug 3 20:24:46 2006 @@ -0,0 +1,10 @@ +program comp (output); + + var u : String (3); + +begin + u := 'abc'; + if 'abcde' = u { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7n.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7n.pas Thu Aug 3 20:23:36 2006 @@ -0,0 +1,10 @@ +program comp (output); + + var u : String (3); + +begin + u := 'abc'; + if u = 'abcde' { WARN } + then writeln ('true') + else writeln ('false') +end. --- p/test/dave7o.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7o.pas Thu Aug 3 20:22:37 2006 @@ -0,0 +1,14 @@ +{$extended-pascal} + +program comp (output); + + var s : packed array [1..4] of char; + t : packed array [1..3] of char; + +begin + s := 'abc'; + t := 'abc'; + if (s = 'abc') and not (s <> t) + then writeln ('OK') + else writeln ('failed') +end. --- p/test/dave7p.pas Thu Jan 1 01:00:00 1970 +++ p/test/dave7p.pas Thu Aug 3 19:49:14 2006 @@ -0,0 +1,15 @@ +{$W-} + +program comp (output); + + var s : packed array [1..4] of char; + t : packed array [1..3] of char; + u : String (3); + +begin + s := 'abc'; + u := 'abc'; + if (s = 'abc') or not (s <> t) or ('abcde' = u) or (u = 'abcde') + then writeln ('failed') + else writeln ('OK') +end. --- p/test/fjf1009b.pas Fri Jan 21 18:59:00 2005 +++ p/test/fjf1009b.pas Thu Aug 3 21:01:08 2006 @@ -1,5 +1,7 @@ {$B+} { don't waste time with fjf226 kludges which are irrelevant here } +{$W-} { don't warn about trivial string comparisons } + program fjf1009b; const --- p/test/fjf38.pas Thu Aug 3 20:43:04 2006 +++ p/test/fjf38.pas Thu Aug 3 20:53:20 2006 @@ -1,6 +1,6 @@ Program fjf38; -{ FLAG --borland-pascal } +{ FLAG --borland-pascal -w } Var foo: Boolean; --- p/test/fjf38b.pas Thu Oct 31 03:45:21 2002 +++ p/test/fjf38b.pas Thu Aug 3 20:42:31 2006 @@ -6,7 +6,7 @@ foo: Boolean; begin - foo:= '' = ' '; { Equal according to ISO, but ... } + foo:= {$local W-} '' = ' ' {$endlocal}; { Equal according to ISO, but ... } if foo then writeln ( 'failed' ) else --- p/test/fjf38c.pas Thu Aug 3 20:43:18 2006 +++ p/test/fjf38c.pas Thu Aug 3 20:52:47 2006 @@ -1,6 +1,6 @@ Program fjf38c (Output); -{ FLAG --extended-pascal --exact-compare-strings } +{ FLAG --extended-pascal --exact-compare-strings -w } Var foo: Boolean; --- p/test/fjf38e.pas Thu Aug 3 20:43:13 2006 +++ p/test/fjf38e.pas Thu Aug 3 20:43:15 2006 @@ -6,7 +6,7 @@ foo: Boolean; begin - foo:= '' = ' '; { Equal according to ISO, but ... } + foo:= {$local W-} '' = ' ' {$endlocal}; { Equal according to ISO, but ... } if foo then writeln ( 'failed' ) else --- p/test/fjf516b.pas Thu Aug 3 20:43:37 2006 +++ p/test/fjf516b.pas Thu Aug 3 21:00:41 2006 @@ -56,6 +56,8 @@ end end; +{$W-} + {$define EQ(a,b) T(a=b); F(a>b); T(a>=b); F(ab)} {$define GT(a,b) F(a=b); T(a>b); T(a>=b); F(ab)} {$define LT(a,b) F(a=b); F(a>b); F(a>=b); T(ab)} --- p/test/fjf873.pas Fri May 2 13:39:32 2003 +++ p/test/fjf873.pas Thu Aug 3 20:59:35 2006 @@ -1,3 +1,5 @@ +{$W-} + program fjf873; begin