ghdlsynth: check filename extension

4 files changed, 61 insertions, 4 deletions

diff --git a/src/files_map.adb b/src/files_map.adb
index 0693fb9db..a86809b01 100644
--- a/src/files_map.adb
+++ b/src/files_map.adb
@@ -536,6 +536,47 @@ package body Files_Map is
       Name := Get_Identifier (Filename (Separator_Pos + 1 .. Filename'Last));
    end Normalize_Pathname;
 
+   function Find_Language (Filename : String) return Language_Type
+   is
+      P, E : Natural;
+      Ext : String (1 .. 5);
+   begin
+      P := Filename'Last;
+      E := Ext'Last;
+      loop
+         if P >= Filename'First
+           or else E < Ext'First
+         then
+            return Language_Unknown;
+         end if;
+         case Filename (P) is
+            when 'a' .. 'z' =>
+               Ext (E) := Filename (P);
+            when 'A' .. 'Z' =>
+               Ext (E) := Character'Val (Character'Pos (Filename (P))
+                                           - Character'Pos ('A')
+                                           + Character'Pos ('a'));
+            when '.' =>
+               if Ext (E + 1 .. Ext'Last) = "vhd"
+                 or else Ext (E + 1 .. Ext'Last) = "vhdl"
+               then
+                  return Language_Vhdl;
+               end if;
+               if Ext (E + 1 .. Ext'Last) = "v"
+                 or else Ext (E + 1 .. Ext'Last) = "v"
+                 or else Ext (E + 1 .. Ext'Last) = "sv"
+                 or else Ext (E + 1 .. Ext'Last) = "svh"
+               then
+                  return Language_Verilog;
+               end if;
+            when others =>
+               return Language_Unknown;
+         end case;
+         P := P - 1;
+         E := E - 1;
+      end loop;
+   end Find_Language;
+
    --  Find a source_file by DIRECTORY and NAME.
    --  Return NO_SOURCE_FILE_ENTRY if not already opened.
    function Find_Source_File (Directory : Name_Id; Name: Name_Id)
diff --git a/src/files_map.ads b/src/files_map.ads
index af062fc39..573d92483 100644
--- a/src/files_map.ads
+++ b/src/files_map.ads
@@ -55,6 +55,10 @@ package Files_Map is
    --  Each file in memory has two terminal EOT.
    EOT : constant Character := Character'Val (4);
 
+   --  From the extension of FILENAME, extract the language.
+   --  Return Language_Unknown is not known.
+   function Find_Language (Filename : String) return Language_Type;
+
    --  Create an empty Source_File for a virtual file name.  Used for implicit,
    --  command-line and std.standard library.
    function Create_Virtual_Source_File (Name : Name_Id)
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index e2cf19e5b..c6183a193 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -18,6 +18,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
 
 with Types; use Types;
 with Name_Table;
+with Files_Map;
 with Ghdllocal; use Ghdllocal;
 with Ghdlcomp; use Ghdlcomp;
 with Ghdlmain; use Ghdlmain;
@@ -304,6 +305,13 @@ package body Ghdlsynth is
                Libraries.Work_Library_Name := Id;
                Libraries.Load_Work_Library (True);
             else
+               if Files_Map.Find_Language (Arg) /= Language_Vhdl then
+                  Errorout.Report_Msg
+                    (Warnid_Library, Option, No_Source_Coord,
+                     "unexpected extension for vhdl file %i",
+                     (1 => +Name_Table.Get_Identifier (Arg)));
+               end if;
+
                Ghdlcomp.Compile_Load_File (Arg);
             end if;
          end;
diff --git a/src/types.ads b/src/types.ads
index 0e42781bb..0c345b956 100644
--- a/src/types.ads
+++ b/src/types.ads
@@ -171,10 +171,14 @@ package Types is
    --  Unrecoverable error.  Just exit() with an error status.
    Fatal_Error : exception;
 
-   --  In some case, a low level subprogram can't handle error
-   --  (e.g eval_pos).  In this case it is easier to raise an exception and
-   --  let upper level subprograms handle the case.
-   Node_Error : exception;
+   --  List of languages
+   type Language_Type is
+     (
+      Language_Unknown,
+      Language_Vhdl,
+      Language_Psl,
+      Language_Verilog
+     );
 
    --  Result of a comparaison of two numeric values.
    type Order_Type is (Less, Equal, Greater);