Squashed commits from prerequisite PRs #231 and #251

Not need to review here.

Author: petr-bauch

gnat2goto/driver/tree_walk.adb

@@ -1,4 +1,3 @@
-with Uname;                 use Uname;
 with Namet;                 use Namet;
 with Nlists;                use Nlists;
 with Sem;
@@ -1000,6 +999,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
@@ -1008,29 +1009,29 @@ 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);
-               Unit_Is_Subprogram := True;
-            end;
+            --  and update the symbol table entry for this subprogram.
+            Global_Symbol_Table.Replace (Unit_Name, Unit_Symbol);
+            Unit_Is_Subprogram := True;
 
          when N_Package_Body =>
             declare
                Dummy : constant Irep := Do_Subprogram_Or_Block (U);
                pragma Unreferenced (Dummy);
             begin
+            --  The specification of the package 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);
                Unit_Is_Subprogram := False;
             end;
 
@@ -3575,7 +3576,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);
@@ -4338,12 +4367,9 @@ package body Tree_Walk is
    -------------------------
 
    procedure Do_Withed_Unit_Spec (N : Node_Id) is
-      Unit_Name : constant String := Get_Name_String (Get_Unit_Name (N));
    begin
-      if Defining_Entity (N) = Stand.Standard_Standard or else
-        Unit_Name = "system%s"
-      then
-         --  At the moment Standard or System are not processed: TODO
+      if Defining_Entity (N) = Stand.Standard_Standard then
+         --  At the moment Standard is not processed: TODO
          null;
       else
          --  Handle all other withed library unit declarations
@@ -4373,8 +4399,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;
@@ -4915,8 +4942,40 @@ package body Tree_Walk is
             --  be called from Ada, or a foreign-language variable to be
             --  accessed from Ada. This would (probably) require gnat2goto to
             --  understand the foreign code, which we do not at the moment.
-            Put_Line (Standard_Error,
-                      "Warning: Multi-language analysis unsupported.");
+            --  However, if the calling convention is specified as "Intrinsic"
+            --  then the subprogram is built into the compiler and gnat2goto
+            --  can safely ignore the pragma.
+            declare
+               --  If the pragma is specified with positional parameter
+               --  association, then the calling convention is the first
+               --  parameter. Check to see if it is Intrinsic.
+               Next_Ass : Node_Id := First (Pragma_Argument_Associations (N));
+               Is_Intrinsic : Boolean := Present (Next_Ass) and then
+                 Nkind (Expression (Next_Ass)) = N_Identifier and then
+                 Get_Name_String (Chars (Expression (Next_Ass))) = "intrinsic";
+            begin
+               --  If the first parameter is not Intrinsic, check named
+               --  parameters for calling convention
+               while not Is_Intrinsic and Present (Next_Ass) loop
+                  if Chars (Next_Ass) /= No_Name and then
+                    Get_Name_String (Chars (Next_Ass)) = "convention"
+                  then
+                     --  The named parameter is Convention, check to see if it
+                     --  is Intrinsic
+                     Is_Intrinsic :=
+                       Get_Name_String (Chars (Expression (Next_Ass))) =
+                       "intrinsic";
+                  end if;
+                     --  Get the next parameter association
+                  Next_Ass := Next (Next_Ass);
+               end loop;
+
+               if not Is_Intrinsic then
+                  Put_Line (Standard_Error,
+                            "Warning: Multi-language analysis unsupported.");
+               end if;
+            end;
+
          when Name_Elaborate =>
             --  Specifies that the body of the named library unit is elaborated
             --  before the current library_item. We will support packages.

testsuite/gnat2goto/tests/intrinsic/test.out

@@ -0,0 +1,6 @@
+Standard_Error from gnat2goto use_import:
+Warning: Multi-language analysis unsupported.
+Warning: Multi-language analysis unsupported.
+
+[overflow.1] file use_import.adb line 16 arithmetic overflow on signed unary minus in -use_import__i: SUCCESS
+VERIFICATION SUCCESSFUL

testsuite/gnat2goto/tests/intrinsic/test.py

@@ -0,0 +1,4 @@
+from test_support import *
+    
+prove("--signed-overflow-check")
+

testsuite/gnat2goto/tests/intrinsic/use_import.adb

@@ -0,0 +1,17 @@
+procedure Use_Import is
+   procedure P (X : Integer);
+   pragma Import (C, P);
+
+   procedure Q (X : Integer);
+   pragma Import (Convention => C, Entity => Q);
+
+   function "-" (X : Integer) return Integer;
+   pragma Import (Convention => Intrinsic, Entity => "-");
+
+   function "+" (Left, Right : Integer) return Integer;
+   pragma Import (Intrinsic, "+");
+
+   I : Integer := 1;
+begin
+   I := -I;
+end Use_Import;