Merged revisions 2338,2412,2445,2469,2485-2486,2501-2502,2508-2509,2514,2516,2530,2535,2537 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r2338 | peter | 2006-01-25 22:46:51 +0100 (Wed, 25 Jan 2006) | 2 lines

  * fix wrong opsize for rangecheck to qword

........
r2412 | jonas | 2006-02-03 12:35:51 +0100 (Fri, 03 Feb 2006) | 2 lines

  * fixed tests/test/trange5

........
r2445 | peter | 2006-02-05 21:18:57 +0100 (Sun, 05 Feb 2006) | 2 lines

  * more check_hints fixes

........
r2469 | jonas | 2006-02-07 15:23:38 +0100 (Tue, 07 Feb 2006) | 3 lines

  * fixed displaying of hints such for procedures and functions
    (and moved check_hints from pbase to htypechk) (forgot to commit earlier)

........
r2485 | jonas | 2006-02-08 21:31:45 +0100 (Wed, 08 Feb 2006) | 2 lines

  * initialise processaddress for darwin

........
r2486 | jonas | 2006-02-08 21:32:32 +0100 (Wed, 08 Feb 2006) | 4 lines

  * the pointer parameter of fpc_Read_Text_PChar_As_Pointer is not an
    out parameter, but a const (the pointer is const and must be
    valid already)

........
r2501 | jonas | 2006-02-09 18:39:22 +0100 (Thu, 09 Feb 2006) | 6 lines

  * fixed bug #4737 (check for potential range errors in for-loop
    assignment, report correct column for potential range errors of
    call parameters)
  * refactored code to check potential range check errors (check_ranges
    in htypechk)

........
r2502 | jonas | 2006-02-09 19:18:47 +0100 (Thu, 09 Feb 2006) | 3 lines

  * fixed web bug #4724 (don't allow inc/dec(pointer,pointer)
  * more accurate error postitions for inc/dec errors

........
r2508 | jonas | 2006-02-10 11:08:07 +0100 (Fri, 10 Feb 2006) | 4 lines

  * kill warnings about non-longint code parameters with val()
    which popped up again after yesterday's patches to the
    potential range error warnings

........
r2509 | jonas | 2006-02-10 12:05:47 +0100 (Fri, 10 Feb 2006) | 3 lines

  * fixed web bug #4778 (explicit type casting of float to int in tp/delphi
    keeps the bit pattern instead of converting)

........
r2514 | jonas | 2006-02-11 09:50:46 +0100 (Sat, 11 Feb 2006) | 2 lines

  * fixed netware compilation

........
r2516 | jonas | 2006-02-11 17:36:08 +0100 (Sat, 11 Feb 2006) | 3 lines

  * change order of foreachnode(static) so the "payload" of a
    statementn is processed before the next statementnodes

........
r2530 | jonas | 2006-02-12 15:29:17 +0100 (Sun, 12 Feb 2006) | 2 lines

  * make classrefdef regable

........
r2535 | jonas | 2006-02-12 16:02:46 +0100 (Sun, 12 Feb 2006) | 2 lines

  * donewidestring has var instead of out parameter

........
r2537 | jonas | 2006-02-12 16:38:56 +0100 (Sun, 12 Feb 2006) | 2 lines

  * set resultloc for interfacecom in subscriptn

........

git-svn-id: branches/fixes_2_0@2562 -

.gitattributes

@@ -5678,8 +5678,11 @@ tests/webtbf/tw4619b.pp svneol=native#text/plain
 tests/webtbf/tw4647.pp svneol=native#text/plain
 tests/webtbf/tw4651.pp svneol=native#text/plain
 tests/webtbf/tw4695.pp svneol=native#text/plain
+tests/webtbf/tw4724.pp svneol=native#text/plain
+tests/webtbf/tw4737.pp svneol=native#text/plain
 tests/webtbf/tw4757.pp svneol=native#text/plain
 tests/webtbf/tw4764.pp svneol=native#text/plain
+tests/webtbf/tw4778a.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
 tests/webtbf/uw0840b.pp svneol=native#text/plain
@@ -6410,6 +6413,7 @@ tests/webtbs/tw4669.pp svneol=native#text/plain
 tests/webtbs/tw4675.pp svneol=native#text/plain
 tests/webtbs/tw4700.pp svneol=native#text/plain
 tests/webtbs/tw4768.pp -text
+tests/webtbs/tw4778.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

compiler/cg64f32.pas

@@ -680,12 +680,12 @@ unit cg64f32;
                else
                  begin
                    hreg:=cg.getintregister(list,OS_32);
+                   opsize:=OS_32;
 
-                   opsize := def_cgsize(fromdef);
-                   if opsize in [OS_64,OS_S64] then
+                   if l.size in [OS_64,OS_S64] then
                      a_load64high_ref_reg(list,l.reference,hreg)
                    else
-                     cg.a_load_ref_reg(list,opsize,OS_32,l.reference,hreg);
+                     cg.a_load_ref_reg(list,l.size,OS_32,l.reference,hreg);
                  end;
                objectlibrary.getlabel(poslabel);
                cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);

compiler/defcmp.pas

@@ -460,9 +460,12 @@ implementation
                case def_from.deftype of
                  orddef :
                    begin { ordinal to real }
-                     if is_integer(def_from) or
-                        (is_currency(def_from) and
-                         (s64currencytype.def.deftype = floatdef)) then
+                     { only for implicit and internal typecasts in tp/delphi }
+                     if (([cdo_explicit,cdo_internal] * cdoptions <> [cdo_explicit]) or
+                         ([m_tp7,m_delphi] * aktmodeswitches = [])) and
+                        (is_integer(def_from) or
+                         (is_currency(def_from) and
+                          (s64currencytype.def.deftype = floatdef))) then
                        begin
                          doconv:=tc_int_2_real;
                          eq:=te_convert_l1;

compiler/htypechk.pas

@@ -27,7 +27,7 @@ interface
 
     uses
       tokens,cpuinfo,
-      node,
+      node,globals,
       symconst,symtype,symdef,symsym,symbase;
 
     type
@@ -150,11 +150,13 @@ interface
 
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions);
 
+    procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
+
 implementation
 
     uses
        globtype,systems,
-       cutils,verbose,globals,
+       cutils,verbose,
        symtable,
        defutil,defcmp,
        nbas,ncnv,nld,nmem,ncal,nmat,ninl,nutils,
@@ -2195,16 +2197,39 @@ implementation
 
 
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions);
-     begin
-       if not assigned(srsym) then
-         exit;
-       if sp_hint_deprecated in symoptions then
-         Message1(sym_w_deprecated_symbol,srsym.realname);
-       if sp_hint_platform in symoptions then
-         Message1(sym_w_non_portable_symbol,srsym.realname);
-       if sp_hint_unimplemented in symoptions then
-         Message1(sym_w_non_implemented_symbol,srsym.realname);
-     end;
+      begin
+        if not assigned(srsym) then
+          internalerror(200602051);
+        if sp_hint_deprecated in symoptions then
+          Message1(sym_w_deprecated_symbol,srsym.realname);
+        if sp_hint_platform in symoptions then
+          Message1(sym_w_non_portable_symbol,srsym.realname);
+        if sp_hint_unimplemented in symoptions then
+          Message1(sym_w_non_implemented_symbol,srsym.realname);
+      end;
+
+
+    procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
+      begin
+        { check if the assignment may cause a range check error }
+        { if its not explicit, and only if the values are       }
+        { ordinals, enumdef and floatdef                        }
+        if assigned(destdef) and
+          (destdef.deftype in [enumdef,orddef,floatdef]) and
+          not is_boolean(destdef) and
+          assigned(source.resulttype.def) and
+          (source.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
+          not is_boolean(source.resulttype.def) then
+         begin
+           if (destdef.size < source.resulttype.def.size) then
+             begin
+               if (cs_check_range in aktlocalswitches) then
+                 MessagePos(location,type_w_smaller_possible_range_check)
+               else
+                 MessagePos(location,type_h_smaller_possible_range_check);
+             end;
+         end;
+      end;
 
 
 end.

compiler/ncal.pas

@@ -633,20 +633,7 @@ type
                        end
                       else
                        begin
-                         { for ordinals, floats and enums, verify if we might cause
-                           some range-check errors. }
-                         if (parasym.vartype.def.deftype in [enumdef,orddef,floatdef]) and
-                            (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
-                            (left.nodetype in [vecn,loadn,calln]) then
-                           begin
-                              if (left.resulttype.def.size>parasym.vartype.def.size) then
-                                begin
-                                  if (cs_check_range in aktlocalswitches) then
-                                     Message(type_w_smaller_possible_range_check)
-                                  else
-                                     Message(type_h_smaller_possible_range_check);
-                                end;
-                           end;
+                         check_ranges(left.fileinfo,left,parasym.vartype.def);
                          inserttypeconv(left,parasym.vartype);
                        end;
                       if codegenerror then
@@ -1796,6 +1783,10 @@ type
                end; { end of procedure to call determination }
            end;
 
+          { check for hints (deprecated etc) }
+          if (procdefinition.deftype = procdef) then
+            check_hints(tprocdef(procdefinition).procsym,tprocdef(procdefinition).symoptions);
+
           { add needed default parameters }
           if assigned(procdefinition) and
              (paralength<procdefinition.maxparacount) then

compiler/ncgmem.pas

@@ -284,6 +284,7 @@ implementation
            end
          else if is_interfacecom(left.resulttype.def) then
            begin
+             location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
              tg.GetTempTyped(exprasmlist,left.resulttype.def,tt_normal,location.reference);
              cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,location.reference);
              { implicit deferencing also for interfaces }

compiler/nflw.pas

@@ -715,7 +715,10 @@ implementation
 
          { Make sure that the loop var and the
            from and to values are compatible types }
+         check_ranges(right.fileinfo,right,left.resulttype.def);
          inserttypeconv(right,left.resulttype);
+
+         check_ranges(t1.fileinfo,t1,left.resulttype.def);
          inserttypeconv(t1,left.resulttype);
 
          if assigned(t2) then

compiler/ninl.pas

@@ -1061,7 +1061,8 @@ implementation
         if assigned(orgcode) then
           addstatement(newstatement,cassignmentnode.create(
               orgcode,
-              ctemprefnode.create(tempcode)));
+              ctypeconvnode.create_internal(
+                ctemprefnode.create(tempcode),orgcode.resulttype)));
 
         { release the temp if we allocated one }
         if assigned(tempcode) then
@@ -1667,17 +1668,23 @@ implementation
                           { two paras ? }
                           if assigned(tcallparanode(left).right) then
                            begin
-                             set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
-                             inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resulttype);
-                             if assigned(tcallparanode(tcallparanode(left).right).right) then
-                               CGMessage(parser_e_illegal_expression);
+                             if is_integer(tcallparanode(left).right.resulttype.def) then
+                               begin
+                                 set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]);
+                                 inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resulttype);
+                                 if assigned(tcallparanode(tcallparanode(left).right).right) then
+                                   { should be handled in the parser (JM) }
+                                   internalerror(2006020901);
+                               end
+                             else
+                               CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected);
                            end;
                         end
                        else
-                        CGMessage(type_e_ordinal_expr_expected);
+                        CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected);
                     end
                   else
-                    CGMessage(type_e_mismatch);
+                    CGMessagePos(fileinfo,type_e_mismatch);
                 end;
 
               in_read_x,

compiler/nld.pas

@@ -494,11 +494,9 @@ implementation
       var
         hp : tnode;
         useshelper : boolean;
-        original_size : longint;
       begin
         result:=nil;
         resulttype:=voidtype;
-        original_size := 0;
 
         { must be made unique }
         set_unique(left);
@@ -642,35 +640,11 @@ implementation
          end
         else
           begin
-           { get the size before the type conversion - check for all nodes }
-           if assigned(right.resulttype.def) and
-              (right.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
-              (right.nodetype in [loadn,vecn,calln]) then
-             original_size := right.resulttype.def.size;
+           { check if the assignment may cause a range check error }
+           check_ranges(fileinfo,right,left.resulttype.def);
            inserttypeconv(right,left.resulttype);
           end;
 
-        { check if the assignment may cause a range check error }
-        { if its not explicit, and only if the values are       }
-        { ordinals, enumdef and floatdef                        }
-        if (right.nodetype = typeconvn) and
-           not (nf_explicit in ttypeconvnode(right).flags) then
-         begin
-            if assigned(left.resulttype.def) and
-              (left.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
-              not is_boolean(left.resulttype.def) then
-              begin
-                if (original_size <> 0) and
-                   (left.resulttype.def.size < original_size) then
-                  begin
-                    if (cs_check_range in aktlocalswitches) then
-                      Message(type_w_smaller_possible_range_check)
-                    else
-                      Message(type_h_smaller_possible_range_check);
-                  end;
-              end;
-         end;
-
         { call helpers for interface }
         if is_interfacecom(left.resulttype.def) then
          begin

compiler/nutils.pas

@@ -129,8 +129,9 @@ implementation
       end;
       if n.inheritsfrom(tbinarynode) then
         begin
-          result := foreachnode(tbinarynode(n).right,f,arg) or result;
+          { first process the "payload" of statementnodes }
           result := foreachnode(tbinarynode(n).left,f,arg) or result;
+          result := foreachnode(tbinarynode(n).right,f,arg) or result;
         end
       else if n.inheritsfrom(tunarynode) then
         result := foreachnode(tunarynode(n).left,f,arg) or result;

compiler/pexpr.pas

@@ -1166,7 +1166,8 @@ implementation
                         begin
                            static_name:=lower(sym.owner.name^)+'_'+sym.name;
                            searchsym(static_name,sym,srsymtable);
-                           check_hints(sym,sym.symoptions);
+			   if assigned(sym) then
+                             check_hints(sym,sym.symoptions);
                            p1.free;
                            p1:=cloadnode.create(sym,srsymtable);
                         end
@@ -1266,7 +1267,8 @@ implementation
                      begin
                        static_name:=lower(srsym.owner.name^)+'_'+srsym.name;
                        searchsym(static_name,srsym,srsymtable);
-                       check_hints(srsym,srsym.symoptions);
+		       if assigned(srsym) then
+                         check_hints(srsym,srsym.symoptions);
                      end
                     else
                      begin
@@ -1339,7 +1341,8 @@ implementation
                                  p1:=ctypenode.create(htype);
                                  { search also in inherited methods }
                                  srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
-                                 check_hints(srsym,srsym.symoptions);
+				 if assigned(srsym) then
+                                   check_hints(srsym,srsym.symoptions);
                                  consume(_ID);
                                  do_member_read(tobjectdef(htype.def),false,srsym,p1,again,[]);
                                end
@@ -1357,16 +1360,19 @@ implementation
                               { TP allows also @TMenu.Load if Load is only }
                               { defined in an anchestor class              }
                               srsym:=search_class_member(tobjectdef(htype.def),pattern);
-                              check_hints(srsym,srsym.symoptions);
-                              if not assigned(srsym) then
-                               Message1(sym_e_id_no_member,orgpattern)
-                              else if not(getaddr) and not(sp_static in srsym.symoptions) then
-                               Message(sym_e_only_static_in_static)
-                              else
-                               begin
-                                 consume(_ID);
-                                 do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
-                               end;
+                              if assigned(srsym) then
+			        begin
+                                  check_hints(srsym,srsym.symoptions);
+  				  if not(getaddr) and not(sp_static in srsym.symoptions) then
+                                    Message(sym_e_only_static_in_static)
+                                  else
+                                    begin
+                                      consume(_ID);
+                                      do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
+				    end;  
+                                end
+			      else	
+                                Message1(sym_e_id_no_member,orgpattern);
                             end;
                          end
                        else
@@ -1383,14 +1389,17 @@ implementation
                                 { TP allows also @TMenu.Load if Load is only }
                                 { defined in an anchestor class              }
                                 srsym:=search_class_member(tobjectdef(htype.def),pattern);
-                                check_hints(srsym,srsym.symoptions);
-                                if not assigned(srsym) then
-                                 Message1(sym_e_id_no_member,orgpattern)
-                                else
+                                if assigned(srsym) then
                                  begin
+                                   check_hints(srsym,srsym.symoptions);
                                    consume(_ID);
                                    do_member_read(tobjectdef(htype.def),getaddr,srsym,p1,again,[]);
-                                 end;
+                                 end
+				else 
+				 begin
+                                   Message1(sym_e_id_no_member,orgpattern);
+                                   consume(_ID);
+				 end;
                               end
                              else
                               begin
@@ -1844,10 +1853,12 @@ implementation
                           if token=_ID then
                             begin
                               hsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
-                              check_hints(hsym,hsym.symoptions);
                               if assigned(hsym) and
                                  (hsym.typ=fieldvarsym) then
-                                p1:=csubscriptnode.create(hsym,p1)
+				begin 
+                                  check_hints(hsym,hsym.symoptions);
+                                  p1:=csubscriptnode.create(hsym,p1)
+				end  
                               else
                                 begin
                                   Message1(sym_e_illegal_field,pattern);
@@ -1866,7 +1877,6 @@ implementation
                              begin
                                classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
                                hsym:=searchsym_in_class(classh,pattern);
-                               check_hints(hsym,hsym.symoptions);
                                if hsym=nil then
                                  begin
                                    Message1(sym_e_id_no_member,orgpattern);
@@ -1877,6 +1887,7 @@ implementation
                                  end
                                else
                                  begin
+                                   check_hints(hsym,hsym.symoptions);
                                    consume(_ID);
                                    do_member_read(classh,getaddr,hsym,p1,again,[]);
                                  end;
@@ -1892,7 +1903,6 @@ implementation
                                allow_only_static:=false;
                                classh:=tobjectdef(p1.resulttype.def);
                                hsym:=searchsym_in_class(classh,pattern);
-                               check_hints(hsym,hsym.symoptions);
                                allow_only_static:=store_static;
                                if hsym=nil then
                                  begin
@@ -1904,6 +1914,7 @@ implementation
                                  end
                                else
                                  begin
+                                    check_hints(hsym,hsym.symoptions);
                                     consume(_ID);
                                     do_member_read(classh,getaddr,hsym,p1,again,[]);
                                  end;

compiler/symdef.pas

@@ -1318,7 +1318,8 @@ implementation
         case deftype of
           orddef,
           pointerdef,
-          enumdef:
+          enumdef,
+          classrefdef:
             is_intregable:=true;
           procvardef :
             is_intregable:=not(po_methodpointer in tprocvardef(self).procoptions);

compiler/widestr.pas

@@ -44,7 +44,7 @@ unit widestr;
        end;
 
     procedure initwidestring(out r : pcompilerwidestring);
-    procedure donewidestring(out r : pcompilerwidestring);
+    procedure donewidestring(var r : pcompilerwidestring);
     procedure setlengthwidestring(r : pcompilerwidestring;l : SizeInt);
     function getlengthwidestring(r : pcompilerwidestring) : SizeInt;
     procedure concatwidestringchar(r : pcompilerwidestring;c : tcompilerwidechar);
@@ -74,7 +74,7 @@ unit widestr;
          r^.maxlen:=0;
       end;
 
-    procedure donewidestring(out r : pcompilerwidestring);
+    procedure donewidestring(var r : pcompilerwidestring);
 
       begin
          if assigned(r^.data) then

rtl/inc/compproc.inc

@@ -194,7 +194,7 @@ procedure fpc_vararray_put(var d : variant;const s : variant;indices : psizeint;
 Procedure fpc_Read_End(var f:Text); compilerproc;
 Procedure fpc_ReadLn_End(var f : Text); compilerproc;
 Procedure fpc_Read_Text_ShortStr(var f : Text;out s : String); compilerproc;
-Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text;out s : PChar); compilerproc;
+Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text; const s : PChar); compilerproc;
 Procedure fpc_Read_Text_PChar_As_Array(var f : Text;out s : array of char); compilerproc;
 Procedure fpc_Read_Text_AnsiStr(var f : Text;out s : AnsiString); compilerproc;
 Procedure fpc_Read_Text_Char(var f : Text; out c : char); compilerproc;

rtl/inc/lineinfo.pp

@@ -68,7 +68,7 @@ var
   filestab   : tstab;   { stab with current file info }
   { value to subtract to addr parameter to get correct address on file }
   { this should be equal to the process start address in memory        }
-  processaddress : cardinal;
+  processaddress : ptruint;
 
 
 
@@ -861,6 +861,7 @@ var
    mh:MachoHeader;
    i: longint;
 begin
+  processaddress := 0;
   StabsFunctionRelative:=false;
   LoadMachO32PPC := false;
   blockread (f, mh, sizeof(mh));
@@ -1096,7 +1097,7 @@ var
 begin
   { reset to prevent infinite recursion if problems inside the code PM }
   {$ifdef netware}
-  dec(addr,system.NWGetCodeStart);  {we need addr relative to code start on netware}
+  dec(addr,ptruint(system.NWGetCodeStart));  {we need addr relative to code start on netware}
   {$endif}
   Store:=BackTraceStrFunc;
   BackTraceStrFunc:=@SysBackTraceStr;

rtl/inc/text.inc

@@ -947,7 +947,7 @@ Begin
 End;
 
 
-Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text;out s : PChar); iocheck; [Public,Alias:'FPC_READ_TEXT_PCHAR_AS_POINTER']; compilerproc;
+Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text; const s : PChar); iocheck; [Public,Alias:'FPC_READ_TEXT_PCHAR_AS_POINTER']; compilerproc;
 Begin
   pchar(s+ReadPCharLen(f,s,$7fffffff))^:=#0;
 End;

tests/webtbf/tw4724.pp

@@ -0,0 +1,6 @@
+{ %fail }
+var
+  p1, p2: pointer;
+begin
+  dec(p1,p2);
+end.

tests/webtbf/tw4737.pp

@@ -0,0 +1,9 @@
+{ %fail }
+{ %OPT=-Seh -vh}
+
+var a:int64;
+i:integer;
+begin
+a:=0;
+for i:=a to 10 do;
+end.

tests/webtbf/tw4778a.pp

@@ -0,0 +1,21 @@
+{ %fail }
+
+{ Source provided for Free Pascal Bug Report 4778 }
+{ Submitted by "Phil H." on  2006-02-06 }
+{ e-mail: [email protected] }
+program Test1;
+
+{$mode delphi}
+
+var
+  AnInt : Integer;
+  
+begin
+
+  AnInt := 1;
+  
+//  WriteLn(Single(AnInt));
+
+  WriteLn(Double(AnInt));
+  
+end.

tests/webtbs/tw4778.pp

@@ -0,0 +1,20 @@
+{ Source provided for Free Pascal Bug Report 4778 }
+{ Submitted by "Phil H." on  2006-02-06 }
+{ e-mail: [email protected] }
+program Test1;
+
+{$mode delphi}
+
+var
+  AnInt : Integer;
+  
+begin
+
+  AnInt := 1;
+  
+  if single(anint) > 0.9 then
+    halt(1);
+
+//  WriteLn(Double(AnInt));
+  
+end.