Commit 547c5954 by Arnaud Charlet

[multiple changes]

2010-06-17  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb (Test_Ref): Abandon scan if access subprogram parameter
	found.

2010-06-17  Vincent Celier  <celier@adacore.com>

	* back_end.adb: Minor comment updates
	* switch-c.adb: Remove dependencies on gcc C sources
        * gcc-interface/Make-lang.in: Add a-comlin.o to the object file list
	for the compiler.

From-SVN: r160884
parent cc86c05a
2010-06-17 Robert Dewar <dewar@adacore.com>
* sem_warn.adb (Test_Ref): Abandon scan if access subprogram parameter
found.
2010-06-17 Vincent Celier <celier@adacore.com>
* back_end.adb: Minor comment updates
* switch-c.adb: Remove dependencies on gcc C sources
* gcc-interface/Make-lang.in: Add a-comlin.o to the object file list
for the compiler.
2010-06-17 Ed Schonberg <schonberg@adacore.com> 2010-06-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb: propagate Pragma_Enabled flag to generic. * sem_ch12.adb: propagate Pragma_Enabled flag to generic.
......
...@@ -48,15 +48,15 @@ package body Back_End is ...@@ -48,15 +48,15 @@ package body Back_End is
flag_stack_check : Int; flag_stack_check : Int;
pragma Import (C, flag_stack_check); pragma Import (C, flag_stack_check);
-- Indicates if stack checking is enabled, imported from toplev.c -- Indicates if stack checking is enabled, imported from decl.c
save_argc : Nat; save_argc : Nat;
pragma Import (C, save_argc); pragma Import (C, save_argc);
-- Saved value of argc (number of arguments), imported from toplev.c -- Saved value of argc (number of arguments), imported from misc.c
save_argv : Arg_Array_Ptr; save_argv : Arg_Array_Ptr;
pragma Import (C, save_argv); pragma Import (C, save_argv);
-- Saved value of argv (argument pointers), imported from toplev.c -- Saved value of argv (argument pointers), imported from misc.c
function Len_Arg (Arg : Pos) return Nat; function Len_Arg (Arg : Pos) return Nat;
-- Determine length of argument number Arg on original gnat1 command line -- Determine length of argument number Arg on original gnat1 command line
...@@ -284,7 +284,7 @@ package body Back_End is ...@@ -284,7 +284,7 @@ package body Back_End is
Opt.No_Stdlib := True; Opt.No_Stdlib := True;
elsif Is_Front_End_Switch (Argv) then elsif Is_Front_End_Switch (Argv) then
Scan_Front_End_Switches (Argv, Next_Arg); Scan_Front_End_Switches (Argv, Integer (Next_Arg));
-- All non-front-end switches are back-end switches -- All non-front-end switches are back-end switches
......
...@@ -120,6 +120,7 @@ GNAT1_C_OBJS = ada/b_gnat1.o ada/adadecode.o ada/adaint.o ada/cstreams.o \ ...@@ -120,6 +120,7 @@ GNAT1_C_OBJS = ada/b_gnat1.o ada/adadecode.o ada/adaint.o ada/cstreams.o \
GNAT_ADA_OBJS = \ GNAT_ADA_OBJS = \
ada/a-charac.o \ ada/a-charac.o \
ada/a-chlat1.o \ ada/a-chlat1.o \
ada/a-comlin.o \
ada/a-elchha.o \ ada/a-elchha.o \
ada/a-except.o \ ada/a-except.o \
ada/a-ioexce.o \ ada/a-ioexce.o \
......
...@@ -539,6 +539,22 @@ package body Sem_Warn is ...@@ -539,6 +539,22 @@ package body Sem_Warn is
return Abandon; return Abandon;
end if; end if;
-- If any of the arguments are of type access to subprogram, then
-- we may have funny side effects, so no warning in this case.
declare
Actual : Node_Id;
begin
Actual := First_Actual (N);
while Present (Actual) loop
if Is_Access_Subprogram_Type (Etype (Actual)) then
return Abandon;
else
Next_Actual (Actual);
end if;
end loop;
end;
-- Declaration of the variable in question -- Declaration of the variable in question
elsif Nkind (N) = N_Object_Declaration elsif Nkind (N) = N_Object_Declaration
......
...@@ -23,6 +23,8 @@ ...@@ -23,6 +23,8 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Command_Line; use Ada.Command_Line;
with Debug; use Debug; with Debug; use Debug;
with Lib; use Lib; with Lib; use Lib;
with Osint; use Osint; with Osint; use Osint;
...@@ -38,27 +40,12 @@ with System.WCh_Con; use System.WCh_Con; ...@@ -38,27 +40,12 @@ with System.WCh_Con; use System.WCh_Con;
package body Switch.C is package body Switch.C is
type Arg_Array is array (Nat) of Big_String_Ptr;
type Arg_Array_Ptr is access Arg_Array;
-- Types to access compiler arguments
save_argc : Nat;
pragma Import (C, save_argc);
-- Saved value of argc (number of arguments), imported from toplev.c
save_argv : Arg_Array_Ptr;
pragma Import (C, save_argv);
-- Saved value of argv (argument pointers), imported from toplev.c
RTS_Specified : String_Access := null; RTS_Specified : String_Access := null;
-- Used to detect multiple use of --RTS= flag -- Used to detect multiple use of --RTS= flag
function Len_Arg (Arg : Pos) return Nat;
-- Determine length of argument number Arg on original gnat1 command line
function Switch_Subsequently_Cancelled function Switch_Subsequently_Cancelled
(C : String; (C : String;
Arg_Rank : Pos) Arg_Rank : Positive)
return Boolean; return Boolean;
-- This function is called from Scan_Front_End_Switches. It determines if -- This function is called from Scan_Front_End_Switches. It determines if
-- the switch currently being scanned is followed by a switch of the form -- the switch currently being scanned is followed by a switch of the form
...@@ -66,28 +53,13 @@ package body Switch.C is ...@@ -66,28 +53,13 @@ package body Switch.C is
-- and Scan_Front_End_Switches will cancel the effect of the switch. If -- and Scan_Front_End_Switches will cancel the effect of the switch. If
-- no such switch is found, False is returned. -- no such switch is found, False is returned.
-------------
-- Len_Arg --
-------------
function Len_Arg (Arg : Pos) return Nat is
begin
for J in 1 .. Nat'Last loop
if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
return J - 1;
end if;
end loop;
raise Program_Error;
end Len_Arg;
----------------------------- -----------------------------
-- Scan_Front_End_Switches -- -- Scan_Front_End_Switches --
----------------------------- -----------------------------
procedure Scan_Front_End_Switches procedure Scan_Front_End_Switches
(Switch_Chars : String; (Switch_Chars : String;
Arg_Rank : Pos) Arg_Rank : Positive)
is is
First_Switch : Boolean := True; First_Switch : Boolean := True;
-- False for all but first switch -- False for all but first switch
...@@ -1126,19 +1098,16 @@ package body Switch.C is ...@@ -1126,19 +1098,16 @@ package body Switch.C is
function Switch_Subsequently_Cancelled function Switch_Subsequently_Cancelled
(C : String; (C : String;
Arg_Rank : Pos) Arg_Rank : Positive)
return Boolean return Boolean
is is
Arg : Pos; Arg : Positive;
Max : constant Natural := Argument_Count;
begin begin
Arg := Arg_Rank + 1; Arg := Arg_Rank + 1;
while Arg < save_argc loop while Arg < Max loop
declare declare
Argv_Ptr : constant Big_String_Ptr := save_argv (Arg); Argv : constant String := Argument (Arg);
Argv_Len : constant Nat := Len_Arg (Arg);
Argv : constant String :=
Argv_Ptr (1 .. Natural (Argv_Len));
begin begin
if Argv = "-gnat-" & C then if Argv = "-gnat-" & C then
return True; return True;
......
...@@ -33,7 +33,7 @@ package Switch.C is ...@@ -33,7 +33,7 @@ package Switch.C is
procedure Scan_Front_End_Switches procedure Scan_Front_End_Switches
(Switch_Chars : String; (Switch_Chars : String;
Arg_Rank : Pos); Arg_Rank : Positive);
-- Procedures to scan out front end switches stored in the given string. -- Procedures to scan out front end switches stored in the given string.
-- The first character is known to be a valid switch character, and there -- The first character is known to be a valid switch character, and there
-- are no blanks or other switch terminator characters in the string, so -- are no blanks or other switch terminator characters in the string, so
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment