Environment debugging test suite (#1668)

Author: housel

sources/dfmc/conversion/convert.dylan

@@ -1648,8 +1648,10 @@ define method convert-next-method-into
      next-ref :: <value-reference>)
  => ()
   f.^function-next? := #t;
+  let loc = lambda-source-location(f);
   let fragment
-    = with-expansion-source-form (model-definition(f))
+    = with-expansion-source-location (loc & source-location-record(loc),
+                                      loc & source-location-source-position(loc))
         generate-next-method-function-fragment(f, signature-spec, next-ref)
       end;
   let (f-start, f-end, f-temp) = convert-1(env, fragment);

sources/environment/commands/application/debugging.dylan

@@ -354,6 +354,7 @@ define method do-execute-command
     (context,
      run-application, project,
      client:                    context,
+     initialize-client:         initialize-application-client,
      machine:                   machine | unsupplied(),
      startup-option:            case
                                   debug?    => #"debug";
@@ -662,7 +663,7 @@ end method parse-next-argument;
 
 /// Application callbacks
 
-define sideways method initialize-application-client
+define function initialize-application-client
     (context :: <environment-context>, application :: <application>) => ()
   register-application-callbacks
     (application,
@@ -690,7 +691,7 @@ define sideways method initialize-application-client
                     application.application-filename);
           end,
           message-type: <run-application-failed-message>);
-end method initialize-application-client;
+end function initialize-application-client;
 
 
 define method start-debugging

sources/environment/dfmc/application/control-protocols.dylan

@@ -33,6 +33,7 @@ define method run-application
     (application :: <dfmc-application>,
      #key startup-option :: <symbol> = #"start",
           client,
+          initialize-client,
           filename :: false-or(<file-locator>),
           arguments :: false-or(<string>),
           process :: false-or(<process>) = #f,
@@ -44,6 +45,7 @@ define method run-application
           pause-before-termination? :: <boolean> = #f)
  => (application :: <dfmc-application>)
   ignore(client);
+  ignore(initialize-client);
 
   // A couple of conveniences for filename processing stolen from
   // the console debugger.

sources/environment/dfmc/application/stack-frame-objects.dylan

@@ -145,59 +145,6 @@ define method stack-frame-type
 end method stack-frame-type;
 
 
-///// STACK-FRAME-PREVIOUS-FRAME (Environment Protocol Method)
-//    Descends the stack trace.
-
-define method stack-frame-previous-frame
-    (application :: <dfmc-application>, sf :: <stack-frame-object>)
- => (prev :: false-or(<stack-frame-object>))
-  let prev-dm-frame = #f;
-  let target = application.application-target-app;
-  let dm-frame = sf.application-object-proxy;
-
-  perform-requiring-debugger-transaction
-    (target,
-     method ()
-       prev-dm-frame := previous-stack-frame(target, dm-frame);
-     end method);
-
-  if (prev-dm-frame)
-    make-environment-object(<stack-frame-object>,
-                            project: application.server-project,
-                            application-object-proxy: prev-dm-frame);
-  else
-    #f
-  end if;
-end method stack-frame-previous-frame;
-
-
-///// STACK-FRAME-NEXT-FRAME (Environment Protocol Method)
-//    Ascends the stack trace.
-
-define method stack-frame-next-frame
-    (application :: <dfmc-application>, sf :: <stack-frame-object>)
- => (prev :: false-or(<stack-frame-object>))
-
-  let nxt-dm-frame = #f;
-  let target = application.application-target-app;
-  let dm-frame = sf.application-object-proxy;
-
-  perform-requiring-debugger-transaction
-    (target,
-     method ()
-       nxt-dm-frame := next-stack-frame(target, dm-frame);
-     end method);
-
-  if (nxt-dm-frame)
-    make-environment-object(<stack-frame-object>,
-                            project: application.server-project,
-                            application-object-proxy: nxt-dm-frame);
-  else
-    #f
-  end if;
-end method stack-frame-next-frame;
-
-
 ///// STACK-FRAME-LOCAL-VARIABLES (Environment Protocol Method)
 //    Builds <local-variable-object>s for the variables known to be live
 //    in the given stack frame.

sources/environment/dfmc/application/thread-objects.dylan

@@ -223,26 +223,6 @@ define method application-threads
 end method application-threads;
 
 
-///// THREAD-STACK-TRACE (Environment Protocol Method)
-//    Returns the frame at the top of the stack for this thread.
-
-define method thread-stack-trace
-    (application :: <dfmc-application>, thread :: <thread-object>)
- => (top-frame :: <stack-frame-object>)
-  let top-dm-frame = #f;
-  let target = application.application-target-app;
-  let remote-thread = thread.application-object-proxy;
-  perform-requiring-debugger-transaction
-     (target,
-      method ()
-        top-dm-frame := first-stack-frame(target, remote-thread);
-      end method);
-  make-environment-object(<stack-frame-object>,
-                          project: application.server-project,
-                          application-object-proxy: top-dm-frame);
-end method;
-
-
 ///// THREAD-COMPLETE-STACK-TRACE (Environment Protocol Method)
 //    Returns an ordered sequence of <stack-frame-object>s - all the frames
 //    in the call stack of the specified thread.

sources/environment/dfmc/projects/library.dylan

@@ -67,7 +67,7 @@ define module dfmc-environment-projects
   use dfmc-progress-reports,
     import: { internal-reporting-setter };
   use build-system,
-    import: { $personal-bin, system-release-path };
+    import: { $personal-bin, system-release-path, $build-system-makefile-name };
 
   export <native-project-object>,
          <dfmc-project-object>;

sources/environment/dfmc/projects/projects.dylan

@@ -828,8 +828,6 @@ define sealed method project-can-be-debugged?
   //   | project-object.project-debug-filename ~= #f
 end method project-can-be-debugged?;
 
-define constant $build-makefile = "dylanmakefile";
-
 define sealed method project-compiled?
     (project :: <dfmc-project-object>)
  => (compiled? :: <boolean>)
@@ -839,7 +837,7 @@ define sealed method project-compiled?
     let makefile
       = make(<native-file-locator>,
              directory: as(<directory-locator>, build-location),
-             name:      $build-makefile);
+             name:      $build-system-makefile-name);
     file-exists?(makefile)
   else
     #t

sources/environment/protocols/applications.dylan

@@ -108,6 +108,7 @@ define open generic run-application
     (server :: <server>,
      #key startup-option,
           client,
+          initialize-client,
           filename,
           arguments,
           pause-before-termination?,
@@ -116,9 +117,6 @@ define open generic run-application
           machine)
  => (application :: <application>);
 
-define open generic initialize-application-client
-    (client :: <object>, application :: <application>) => ();
-
 // There's no NOTE-RUN-APPLICATION-REQUESTED, we just do the relevant
 // work in RUN-APPLICATION.
 
@@ -183,11 +181,6 @@ define method perform-application-transaction
   end
 end method perform-application-transaction;
 
-define method initialize-application-client
-    (client :: <object>, application :: <application>) => ()
-  #f
-end method initialize-application-client;
-
 define method note-application-initialized
     (project :: <project-object>)
  => ()
@@ -260,6 +253,7 @@ define method run-application
     (project :: <project-object>,
      #key startup-option = #"start",
           client = project,
+          initialize-client :: <function> = ignore,
           filename,
           arguments,
           working-directory,
@@ -297,7 +291,7 @@ define method run-application
   end if;
   broadcast($project-channel,
             make(<run-application-requested-message>, project: project));
-  initialize-application-client(client, application);
+  initialize-client(client, application);
   let host-machine? = machine == environment-host-machine();
   run-application(application,
                   startup-option: startup-option,

sources/environment/protocols/module.dylan

@@ -309,7 +309,6 @@ define module environment-protocols
 
   // Threads objects
   export <thread-object>,
-         thread-stack-trace,
          thread-complete-stack-trace,
          thread-index,
          thread-state,
@@ -388,7 +387,6 @@ define module environment-protocols
          find-application-proxy,
          application-proxy-id,
          run-application,
-         initialize-application-client,
          attach-live-application,
          note-run-application-failed,
          stop-application,
@@ -636,8 +634,6 @@ define module environment-protocols
          stack-frame-source-location,
          stack-frame-thread,
          stack-frame-type,
-         stack-frame-next-frame,
-         stack-frame-previous-frame,
          stack-frame-local-variables,
          stack-frame-local-variable-count;
 

sources/environment/protocols/stack-frame-objects.dylan

@@ -93,20 +93,6 @@ define open generic stack-frame-type
     (server :: <server>, stack-frame :: <stack-frame-object>)
  => (type :: <symbol>);
 
-/// stack-frame-next-frame
-///
-///
-define open generic stack-frame-next-frame
-    (server :: <server>, stack-frame :: <stack-frame-object>)
- => (next-one :: false-or(<stack-frame-object>));
-
-/// stack-frame-previous-frame
-///
-///
-define open generic stack-frame-previous-frame
-    (server :: <server>, stack-frame :: <stack-frame-object>)
- => (previous-one :: false-or(<stack-frame-object>));
-
 /// stack-frame-local-variables
 ///
 ///