Set return value in Do_Compilation_Unit

to Unit_Symbol for a package body.

To determine a symbol value for a package body a symbol is determined from
its specification and registered in the symbol table. This required checking for
the package being a child.

N.b.: The same check may be required for child subprograms!

Author: tjj2017

gnat2goto/driver/tree_walk.adb

@@ -946,6 +946,8 @@ package body Tree_Walk is
      return Symbol
    is
       U           : constant Node_Id := Unit (N);
+      Unit_Name : constant Symbol_Id :=
+        Intern (Unique_Name (Unique_Defining_Entity (U)));
       Unit_Symbol : Symbol;
    begin
       --  Insert all all specifications of all withed units including the
@@ -954,29 +956,26 @@ package body Tree_Walk is
 
       case Nkind (U) is
          when N_Subprogram_Body =>
-            declare
-               Unit_Name : constant Symbol_Id :=
-                 Intern (Unique_Name (Unique_Defining_Entity (U)));
-            begin
-               --  The specification of the subprogram body has already
-               --  been inserted into the symbol table by the call to
-               --  Do_Withed_Unit_Specs.
-               pragma Assert (Global_Symbol_Table.Contains (Unit_Name));
-               Unit_Symbol := Global_Symbol_Table (Unit_Name);
+            --  The specification of the subprogram body has already
+            --  been inserted into the symbol table by the call to
+            --  Do_Withed_Unit_Specs.
+            pragma Assert (Global_Symbol_Table.Contains (Unit_Name));
+            Unit_Symbol := Global_Symbol_Table (Unit_Name);
 
-               --  Now compile the body of the subprogram
-               Unit_Symbol.Value := Do_Subprogram_Or_Block (U);
+            --  Now compile the body of the subprogram
+            Unit_Symbol.Value := Do_Subprogram_Or_Block (U);
 
-               --  and update the symbol table entry for this subprogram.
-               Global_Symbol_Table.Replace (Unit_Name, Unit_Symbol);
-               Add_Start := True;
-            end;
+            --  and update the symbol table entry for this subprogram.
+            Global_Symbol_Table.Replace (Unit_Name, Unit_Symbol);
+            Add_Start := True;
 
          when N_Package_Body =>
             declare
                Dummy : constant Irep := Do_Subprogram_Or_Block (U);
                pragma Unreferenced (Dummy);
             begin
+               pragma Assert (Global_Symbol_Table.Contains (Unit_Name));
+               Unit_Symbol := Global_Symbol_Table (Unit_Name);
                Add_Start := False;
             end;
 
@@ -3501,7 +3500,35 @@ package body Tree_Walk is
 
    procedure Do_Package_Specification (N : Node_Id) is
       Package_Decs : constant Irep := New_Irep (I_Code_Block);
+      Package_Name : Symbol_Id;
+      Package_Symbol : Symbol;
+      Def_Unit_Name : Node_Id;
+      Entity_Node : Node_Id;
+
    begin
+      Def_Unit_Name := Defining_Unit_Name (N);
+
+      --  Defining_Unit_Name will return a N_Defining_Identifier
+      --  for non-child package but a N_Package_Specification when it is a
+      --  child package.
+      --  To obtain the Entity N_Defining_Identifier is required.
+      --  The actual parameter for Unique_Name must be an Entity node.
+      if Nkind (Def_Unit_Name) = N_Defining_Identifier then
+         Entity_Node := Def_Unit_Name;
+      else
+         Entity_Node := Defining_Identifier (Def_Unit_Name);
+      end if;
+
+      Package_Name := Intern (Unique_Name (Entity_Node));
+      Package_Symbol.Name       := Package_Name;
+      Package_Symbol.BaseName   := Package_Name;
+      Package_Symbol.PrettyName := Package_Name;
+      Package_Symbol.SymType    := New_Irep (I_Void_Type);
+      Package_Symbol.Mode       := Intern ("C");
+      Package_Symbol.Value      := Make_Nil (Sloc (N));
+
+      Global_Symbol_Table.Insert (Package_Name, Package_Symbol);
+
       Set_Source_Location (Package_Decs, Sloc (N));
       if Present (Visible_Declarations (N)) then
          Process_Declarations (Visible_Declarations (N), Package_Decs);
@@ -4303,8 +4330,9 @@ package body Tree_Walk is
             when N_Package_Body =>
                null;
             when others =>
-               Put_Line (Standard_Error,
-                         "This type of library_unit is not yet handled");
+               Report_Unhandled_Node_Empty
+                 (N, "Do_Withed_Unit_Spec",
+                  "This type of library_unit is not yet handled");
          end case;
 
       end if;