taoc4.pp 899 B

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657
  1. { %cpu=i386 }
  2. { This test expects values on the stack, which is i386 only }
  3. { fourth simple array of const test }
  4. {$mode objfpc}
  5. program test_cdecl_array_of_const;
  6. var
  7. l : longint;
  8. const
  9. has_errors : boolean = false;
  10. procedure test_one_longint(args : array of const);cdecl;
  11. var
  12. p : pptrint;
  13. begin
  14. p:=pptrint(@args);
  15. l:=p^;
  16. end;
  17. procedure test_two_longints(args : array of const);cdecl;
  18. var
  19. p : pptrint;
  20. begin
  21. p:=pptrint(@args);
  22. inc(pointer(p),sizeof(ptrint));
  23. l:=p^;
  24. end;
  25. begin
  26. l:=4;
  27. test_one_longint([345]);
  28. if l<>345 then
  29. has_errors:=true;
  30. l:=4;
  31. test_one_longint([345,245]);
  32. if l<>345 then
  33. has_errors:=true;
  34. l:=4;
  35. test_one_longint([345,245,678]);
  36. if l<>345 then
  37. has_errors:=true;
  38. l:=4;
  39. test_two_longints([345,456]);
  40. if l<>456 then
  41. has_errors:=true;
  42. if has_errors then
  43. begin
  44. Writeln('cdecl array of const problem');
  45. halt(1);
  46. end;
  47. end.