-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Sinput.P;
with Snames; use Snames;
with Stringt;
+with Switch; use Switch;
with Table;
with Targparm;
with Tempdir;
end if;
end Set_Library_For;
+ procedure Check_Version_And_Help is
+ new Check_Version_And_Help_G (Non_VMS_Usage);
+
-- Start of processing for GNATCmd
begin
-- If not on VMS, scan the command line directly
else
- if Argument_Count = 0 then
- Non_VMS_Usage;
- return;
- else
- begin
- loop
- if Argument_Count > Command_Arg
- and then Argument (Command_Arg) = "-v"
- then
- Verbose_Mode := True;
- Command_Arg := Command_Arg + 1;
+ -- First, scan to detect --version and/or --help
- elsif Argument_Count > Command_Arg
- and then Argument (Command_Arg) = "-dn"
- then
- Keep_Temporary_Files := True;
- Command_Arg := Command_Arg + 1;
+ Check_Version_And_Help ("GNAT", "1996");
- else
- exit;
- end if;
- end loop;
+ begin
+ loop
+ if Command_Arg <= Argument_Count
+ and then Argument (Command_Arg) = "-v"
+ then
+ Verbose_Mode := True;
+ Command_Arg := Command_Arg + 1;
- The_Command := Real_Command_Type'Value (Argument (Command_Arg));
+ elsif Command_Arg <= Argument_Count
+ and then Argument (Command_Arg) = "-dn"
+ then
+ Keep_Temporary_Files := True;
+ Command_Arg := Command_Arg + 1;
- if Command_List (The_Command).VMS_Only then
- Non_VMS_Usage;
- Fail
- ("Command """
- & Command_List (The_Command).Cname.all
- & """ can only be used on VMS");
+ else
+ exit;
end if;
+ end loop;
- exception
- when Constraint_Error =>
+ -- If there is no command, just output the usage
- -- Check if it is an alternate command
+ if Command_Arg > Argument_Count then
+ Non_VMS_Usage;
+ return;
+ end if;
- declare
- Alternate : Alternate_Command;
+ The_Command := Real_Command_Type'Value (Argument (Command_Arg));
- begin
- Alternate := Alternate_Command'Value
- (Argument (Command_Arg));
- The_Command := Corresponding_To (Alternate);
-
- exception
- when Constraint_Error =>
- Non_VMS_Usage;
- Fail ("Unknown command: " & Argument (Command_Arg));
- end;
- end;
+ if Command_List (The_Command).VMS_Only then
+ Non_VMS_Usage;
+ Fail
+ ("Command """
+ & Command_List (The_Command).Cname.all
+ & """ can only be used on VMS");
+ end if;
+
+ exception
+ when Constraint_Error =>
- -- Get the arguments from the command line and from the eventual
- -- argument file(s) specified on the command line.
+ -- Check if it is an alternate command
- for Arg in Command_Arg + 1 .. Argument_Count loop
declare
- The_Arg : constant String := Argument (Arg);
+ Alternate : Alternate_Command;
begin
- -- Check if an argument file is specified
+ Alternate := Alternate_Command'Value
+ (Argument (Command_Arg));
+ The_Command := Corresponding_To (Alternate);
+
+ exception
+ when Constraint_Error =>
+ Non_VMS_Usage;
+ Fail ("Unknown command: " & Argument (Command_Arg));
+ end;
+ end;
- if The_Arg (The_Arg'First) = '@' then
- declare
- Arg_File : Ada.Text_IO.File_Type;
- Line : String (1 .. 256);
- Last : Natural;
+ -- Get the arguments from the command line and from the eventual
+ -- argument file(s) specified on the command line.
- begin
- -- Open the file and fail if the file cannot be found
+ for Arg in Command_Arg + 1 .. Argument_Count loop
+ declare
+ The_Arg : constant String := Argument (Arg);
- begin
- Open
- (Arg_File, In_File,
- The_Arg (The_Arg'First + 1 .. The_Arg'Last));
+ begin
+ -- Check if an argument file is specified
- exception
- when others =>
- Put
- (Standard_Error, "Cannot open argument file """);
- Put
- (Standard_Error,
- The_Arg (The_Arg'First + 1 .. The_Arg'Last));
+ if The_Arg (The_Arg'First) = '@' then
+ declare
+ Arg_File : Ada.Text_IO.File_Type;
+ Line : String (1 .. 256);
+ Last : Natural;
- Put_Line (Standard_Error, """");
- raise Error_Exit;
- end;
+ begin
+ -- Open the file and fail if the file cannot be found
- -- Read line by line and put the content of each non-
- -- empty line in the Last_Switches table.
+ begin
+ Open
+ (Arg_File, In_File,
+ The_Arg (The_Arg'First + 1 .. The_Arg'Last));
+
+ exception
+ when others =>
+ Put
+ (Standard_Error, "Cannot open argument file """);
+ Put
+ (Standard_Error,
+ The_Arg (The_Arg'First + 1 .. The_Arg'Last));
- while not End_Of_File (Arg_File) loop
- Get_Line (Arg_File, Line, Last);
+ Put_Line (Standard_Error, """");
+ raise Error_Exit;
+ end;
- if Last /= 0 then
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'(Line (1 .. Last));
- end if;
- end loop;
+ -- Read line by line and put the content of each non-
+ -- empty line in the Last_Switches table.
- Close (Arg_File);
- end;
+ while not End_Of_File (Arg_File) loop
+ Get_Line (Arg_File, Line, Last);
- else
- -- It is not an argument file; just put the argument in
- -- the Last_Switches table.
+ if Last /= 0 then
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'(Line (1 .. Last));
+ end if;
+ end loop;
- Last_Switches.Increment_Last;
- Last_Switches.Table (Last_Switches.Last) :=
- new String'(The_Arg);
- end if;
- end;
- end loop;
- end if;
+ Close (Arg_File);
+ end;
+
+ else
+ -- It is not an argument file; just put the argument in
+ -- the Last_Switches table.
+
+ Last_Switches.Increment_Last;
+ Last_Switches.Table (Last_Switches.Last) :=
+ new String'(The_Arg);
+ end if;
+ end;
+ end loop;
end if;
declare
-- warnings on the scope are also suppressed. For the internal case,
-- we ignore this flag.
+ function Is_Call_Of_Generic_Formal return Boolean;
+ -- Returns True if node N is a call to a generic formal subprogram
+
+ -------------------------------
+ -- Is_Call_Of_Generic_Formal --
+ -------------------------------
+
+ function Is_Call_Of_Generic_Formal return Boolean is
+ begin
+ return Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
+
+ -- For now, we detect this by looking for the strange identifier
+ -- node, whose Chars reflect the name of the generic formal, but
+ -- the Chars of the Entity references the generic actual.
+
+ and then Nkind (Name (N)) = N_Identifier
+ and then Chars (Name (N)) /= Chars (Entity (Name (N)));
+ end Is_Call_Of_Generic_Formal;
+
+ -- Start of processing for Check_A_Call
+
begin
-- If the call is known to be within a local Suppress Elaboration
-- pragma, nothing to check. This can happen in task bodies.
-- However, if we are doing dynamic elaboration, we need to chase the
-- call in the usual manner.
- -- We do not handle the case of calling a generic formal correctly in
- -- the static case.???
+ -- We also need to chase the call in the usual manner if it is a call
+ -- to a generic formal parameter, since that case was not handled as
+ -- part of the processing of the template.
Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N)));
Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));
if Unit_Caller /= No_Unit
and then Unit_Callee /= Unit_Caller
and then not Dynamic_Elaboration_Checks
-
- -- This is an attempt to solve the problem of mishandling of
- -- generic formal parameters, but it does not work right yet ???
-
- -- and then not Used_As_Generic_Actual (Ent)
+ and then not Is_Call_Of_Generic_Formal
then
- -- It is here that things go wrong for calling a generic formal???
-
E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
-- If we don't get a spec entity, just ignore call. Not quite
E_Scope := Scope (E_Scope);
end loop;
- -- For the case N is not an instance, or a call within instance, we
- -- recompute E_Scope for the error message, since we do NOT want to
- -- go to the unit which has the ultimate declaration in the case of
- -- renaming and derivation and we also want to go to the generic unit
- -- in the case of an instance, and no further.
+ -- For the case where N is not an instance, and is not a call within
+ -- instance to other than a generic formal, we recompute E_Scope
+ -- for the error message, since we do NOT want to go to the unit
+ -- which has the ultimate declaration in the case of renaming and
+ -- derivation and we also want to go to the generic unit in the
+ -- case of an instance, and no further.
else
-- Loop to carefully follow renamings and derivations one step
projects / thirdparty / gcc.git / commitdiff
