Программа, выводящая сама себя

[Gorychev]

К сожалению никто ничего толкового не посоветовал

[Квэнди]

Ответ я вам дал. в посте 2 детский сад.

[SunKnight]

program SelfWrite;   
  
uses Classes, Windows;   
  
var F:TextFile;   
    Buffer : TStringList;   
procedure Init;   
begin   
   Assign(F, 'Test.pas'); ReWrite(F);   
   Buffer := TStringList.Create;   
end;   
  
procedure Done;   
var i:integer;   
begin   
   Buffer.Add('   Done;');   
   Buffer.Add('end.');   
   for i:=0 to Buffer.Count-1 do WriteLn(F, Buffer[i]);   
   Buffer.Free;   
   Close(F);   
end;   
  
procedure NewStr(S:String);   
var S1:String;   
    i:integer;   
begin   
   WriteLn(F, S);   
   S1 := ';   
   for i:=1 to length(S) do begin   
      if S[i] = ''   
      then S1 := S1 + '''   
      else S1 := S1 + S[i];   
   end;   
   Buffer.Add('   NewStr('''+S+''');');   
end;   
  
begin   
   Init;   
   NewStr('program SelfWrite;');   
   NewStr('');   
   NewStr('uses Classes, Windows;');   
   NewStr('');   
   NewStr('var F:TextFile;');   
   NewStr('    Buffer : TStringList;');   
   NewStr('procedure Init;');   
   NewStr('begin');   
   NewStr('   Assign(F, ''Test.pas''); ReWrite(F);');   
   NewStr('   Buffer := TStringList.Create;');   
   NewStr('end;');   
   NewStr('');   
   NewStr('procedure Done;');   
   NewStr('var i:integer;');   
   NewStr('begin');   
   NewStr('   Buffer.Add(''   Done;'');');   
   NewStr('   Buffer.Add(''end.'');');   
   NewStr('   for i:=0 to Buffer.Count-1 do WriteLn(F, Buffer[i]);');   
   NewStr('   Buffer.Free;');   
   NewStr('   Close(F);');   
   NewStr('end;');   
   NewStr('');   
   NewStr('procedure NewStr(S:String);');   
   NewStr('var S1:String;');   
   NewStr('    i:integer;');   
   NewStr('begin');   
   NewStr('   WriteLn(F, S);');   
   NewStr('   S1 := '';');   
   NewStr('   for i:=1 to length(S) do begin');   
   NewStr('      if S[i] = ''''');   
   NewStr('      then S1 := S1 + ''''''');   
   NewStr('      else S1 := S1 + S[i];');   
   NewStr('   end;');   
   NewStr('   Buffer.Add(''   NewStr(''''''+S+'''''');'');');   
   NewStr('end;');   
   NewStr('');   
   NewStr('begin');   
   NewStr('   Init;');   
   Done;   
end.

извените конечно, но это бред.

 NewStr('      if S[i] = ''''');   
   NewStr('      then S1 := S1 + ''''''');   
   NewStr('      else S1 := S1 + S[i];');   
   NewStr('   end;');   
   NewStr('   Buffer.Add(''   NewStr(''''''+S+'''''');'');');

-этот кусок вы не считаете кодом??? Или это так, чтото левое в коде?

[alexBlack]

Приношу свои извинения за допущенные ошибки. Исправленный текст прикрепил ниже. Не ошибается тот, кто ничего не делает. Проверял следующим образом: компилируем и выполняем файл в Delphi. получаем test.pas. Его копируем в проект снова компилируем и выполняем. Результат тот-же.

Вам не кажется что комментарии "бред" и "детский сад" никак не помогут в поиске ошибок.

Теперь о невозможности. Есть обоснование ?

Вот еще вариант на Pascal - нашел в инете:

var c:array [1..13] of string[60];
    i:integer;
begin
c[ 1]:='var c:array [1..13] of string[60]                           ';
c[ 2]:='    i:integer                                               ';
c[ 3]:='begin                                                       ';
c[ 4]:='for i:=1 to 3 do writeln(c[i])                              ';
c[ 5]:='for i:=1 to 12 do writeln(c[13,1],c[13,2],i:2,c[13,5],      ';
c[ 6]:='              c[13,6],c[13,7],c[13,8],c[i],c[13,8],c[13,9]);';
c[ 7]:='for i:=1 to 8 do write(c[13,i]);                            ';
c[ 8]:='for i:=1 to 8 do write(c[13,i]);                            ';
c[ 9]:='for i:=8 to 59 do write(c[13,i]);                           ';
c[10]:='writeln(c[13,8],c[13,9]);                                   ';
c[11]:='for i:=4 to 12 do writeln(c[i]);                            ';
c[12]:='end.                                                        ';
c[13]:='c[13]:='';                                                  ';
for i:=1 to 3 do writeln(c[i]);
for i:=1 to 12 do writeln(c[13,1],c[13,2],i:2,c[13,5],
                 c[13,6],c[13,7],c[13,8],c[i],c[13,8],c[13,9]);
for i:=1 to 8 do write(c[13,i]);
for i:=1 to 8 do write(c[13,i]);
for i:=8 to 59 do write(c[13,i]);
writeln(c[13,8],c[13,9]);
for i:=4 to 12 do writeln(c[i]);
end.

Еще можно посмотреть на это:

http://www.pixel-apes.com/selftest/

http://habrahabr.ru/blog/crazydev/35371.html

[SunKnight]

У меня предложение заполнить МЕМО (в свойстве LINES) статически, т.е. до RUN-TIM. Просто скопировать листинг. Возможно это бред, но в задании было сказано без особых знаний.

[Gorychev]

..."написать программу, отображающую на экране свой собственный исходный текст" т.е весь тект а не часть
# var c:array [1..13] of string[60];
# i:integer;
# begin
# for i:=1 to 3 do writeln(c[i]);
# for i:=1 to 12 do writeln(c[13,1],c[13,2],i:2,c[13,5],
# c[13,6],c[13,7],c[13,8],c[i],c[13,8],c[13,9]);
# for i:=1 to 8 do write(c[13,i]);
# for i:=1 to 8 do write(c[13,i]);
# for i:=8 to 59 do write(c[13,i]);
# writeln(c[13,8],c[13,9]);
# for i:=4 to 12 do writeln(c[i]);
# end.

Интересная мысль SunKnight >>заполнить МЕМО (в свойстве LINES) статически, т.е. до RUN-TIM. Просто скопировать листинг>> 5 балов, сразу видно небольшой но стабильный сдвиг

[SunKnight]

Все задача решина!!!!!

program Project2;
{$APPTYPE CONSOLE}
uses
  SysUtils;
var i:integer;
    mas:array [0..13] of string;
begin
     mas[0]:='program Project2;';
     mas[1]:='{$APPTYPE CONSOLE}';
     mas[2]:='uses SysUtils;';
     mas[3]:='var i:integer;';
     mas[4]:='mas:array [0..13] of string;';
     mas[5]:='begin';
     mas[6]:='     for i:=0 to 5 do';
     mas[7]:='     writeln(mas[i]);';
     mas[8]:='     for i:=0 to 13 do';
     mas[9]:='     writeln(FUCK)';
     mas[10]:='     for i:=6 to 13 do';
     mas[11]:='     writeln(mas[i]);';
     mas[12]:='readln;';
     mas[13]:='end.';
     for i:=0 to 5 do
        writeln(mas[i]);
     for i:=0 to 13 do
        writeln('mas['+inttostr(i)+']:='+mas[i]);
     for i:=6 to 13 do
        writeln(mas[i]);
readln;
end.

только нужно в строке mas[9]:=' writeln(FUCK)'; вместо FUCK подставить всю строку writeln('mas['+inttostr(i)+']:='+mas[i]);.
там нужно помудрить немного, а то с этими ''''' -выводами запара.
По этому методу можно выводить в МЕМО!

[mutabor]

отображающую на экране свой собственный исходный текст, не обращаясь к чтению файлов

как вы думаете для чего запрет на чтение файлов? наверное чтобы не упрощали решение чтением файла с исходником (pas, cpp и т.д.). Вы же упрощаете еще больше, какой в этом смысл?
Получается программа уровня Hello World, как-то странно для экзамена.

P.S. беру свои слова назад, это действительно не так просто, Квэнди прав пустая программа выведет себя правильно, если же написать хоть одну строку, задача усложняется:

код: PRINT "PRINT "HELLO""
результат: PRINT "HELLO"

на экране всегда будет на одно слово меньше, получается бесконечная рекурсия, к-рую нужно обойти.

[Aristarh Dark]

код: PRINT "PRINT "HELLO""
результат: PRINT "HELLO"

для бейсика решение такое (при условии что программа не пустая):

10 LIST

[merax]

var s:string;begin s:='var s:string;begin

s:=;write(copy(s,1,22),#39,s,#39,copy(s,23,49))end.';write(copy(s,1,22),#39,s,#39,copy(s,23,49))end.

Прога должна быть записана в одну строку, например в файл Hello.pas.

Для компиляции в Delphi7 можно использовать такую командную строку: dcc32 -CC Hello.pas.