Artifact 3d12d610cde5b3fdf0f947f2cf9800d0946253ee8e070fc6de12fb479f08b4c2:

• File psl-1983/tests/main5.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1843) [annotate] [blame] [check-ins using] [more...]

% MAIN5.RED : Small READ-EVAL-PRINT Loop
%             Needs IO, SUB2, SUB3, SUB4, SUB5

IN "xxx-header.red"$
IN "PT:STUBS3.RED"$
IN "PT:STUBS4.RED"$
IN "PT:STUBS5.RED"$

on syslisp;

Compiletime FLUID '(DEBUG FnTypeList !*RAISE !$EOF!$ !*PVAL !*ECHO);

Procedure FirstCall;
Begin scalar x, Done, Hcount;
  Init();
  InitHeap();
  TestGet();
  InitEval();
  Prin2t '"(very) MINI-PSL: A Read-Eval-Print Loop, terminate with Q";
  Prin2T '"       !*RAISE and !*PVAL have been set T";
  Prin2T '"       Should be able to execute any COMPILED expressions";
  Prin2T '"       typed in. Run (TESTSERIES) when ready";
  LispVar(DEBUG) := 'NIL; % For nice I/O
  InitRead();
  LispVar(!$EOF!$) := MkID Char EOF$ 
  Hcount :=0;
  LispVar(!*RAISE) := 'T; %  Upcase input IDs
  While Not Done do 
    <<Hcount:=Hcount+1;
      Prin2 Hcount; Prin2 '" lisp> "; 
      x:=READ();
      if x eq 'Q then Done := 'T
       else if x eq !$EOF!$ then
            <<terpri();
              Prin2T " **** Top Level EOF ****">>
       else <<Terpri();
              x:=EVAL x;
              If LISPVAR(!*PVAL) then Print x>>;
  >>;
  Quit; 
 End;

% ----  Test Routines:

syslsp procedure TestSeries();
 <<Dashed "TESTs called by TESTSERIES";
   TestUndefined()>>;

syslsp procedure TestGet();
Begin
	Dashed "Tests of GET and PUT";
	Shouldbe("GET('FOO,'FEE)",GET('FOO,'FEE),NIL);
	Shouldbe("PUT('FOO,'FEE,'FUM)",PUT('FOO,'FEE,'FUM),'FUM);
	Shouldbe("GET('FOO,'FEE)",GET('FOO,'FEE),'FUM);
	Shouldbe("REMPROP('FOO,'FEE)",REMPROP('FOO,'FEE),'FUM);
	Shouldbe("GET('FOO,'FEE)",GET('FOO,'FEE),NIL);
 end;

syslsp procedure TestUndefined;
  <<Print "Calling SHOULDBEUNDEFINED";
    ShouldBeUndefined(1)>>;
% Some dummies:

procedure UnbindN N;
 Stderror '"UNBIND only added at MAIN6";

procedure Lbind1(x,y);
 StdError '"LBIND1 only added at MAIN6";

Off syslisp;

End;