Skip to content

R
riscv-gcc-1
Commit 5c1c8a03 by Arnaud Charlet
Options

[multiple changes] 

2004-02-18  Emmanuel Briot  <briot@act-europe.fr>

	* ali.ads, ali.adb (First_Sdep_Entry): No longer a constant, so that
	Scan_ALI can be used for multiple ALI files without reinitializing
	between calls.

2004-02-18  Robert Dewar  <dewar@gnat.com>

	* debug.adb: Minor reformatting.

2004-02-18  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* decl.c (gnat_to_gnu_entity, case object): Set DECL_POINTER_ALIAS_SET
	to zero if there is an address clause.

2004-02-18  Thomas Quinot  <quinot@act-europe.fr>

	* exp_util.adb (Side_Effect_Free): Any literal is side effects free.

2004-02-18  Gary Dismukes  <dismukes@gnat.com>

	* layout.adb (Layout_Component_List): Revise generation of call to
	discriminant-checking function to pass selections of all of the type's
	discriminants rather than just the variant-controlling discriminant.

2004-02-18  Olivier Hainque  <hainque@act-europe.fr>

	* 5gmastop.adb (Pop_Frame): Do not call exc_unwind, which is bound to
	fail in the current setup and triggers spurious system error messages.
	Pretend it occurred and failed instead.

2004-02-18  Vincent Celier  <celier@gnat.com>

	* bld.adb: Mark FLDFLAGS as saved
	(Process_Declarative_Items): Add Linker'Linker_Options to FLDFLAGS when
	it is not the root project.  Put each directory to be
	extended between double quotes to prevent it to be expanded on Windows.
	(Recursive_Process): Reset CFLAGS/CXXFLAGS to nothing before processing
	the project file. Set them back to their initial values if they have not
	been set in the project file.

	* gprcmd.adb: (Gprdebug, Debug): New global variables
	(Display_Command): New procedure
	(Usage): Document new command "linkopts"
	Call Display_Command when env var GPRDEBUG has the value "TRUE"
	Implement new command "linkopts"
	Remove quotes that may be around arguments for "extend"
	Always call Normalize_Pathname with arguments formatted for the platform

	* Makefile.generic: Link C/C++ mains with $(FLDFLAGS)
	Change @echo to @$(display) in target clean to be able to clean silently

	* Makefile.prolog: Save FLDFLAGS and give it an initial empty value

	* prj-part.adb (Project_Path_Name_Of): Do not put final result in
	canonical case.

	* prj-part.adb (Parse_Single_Project): Always call with From_Extended
	= Extending_All when current project is an extending all project.

	* vms_conv.adb (Output_File_Expected): New Boolean global variable,
	set to True only for LINK command, after Unix switch -o.
	(Process_Arguments): Set Output_File_Expected to True for LINK command
	after Unix switch -o. When Output_File_Expected is True, never add an
	extension to a file name.

	* 5vml-tgt.adb (Build_Dynamic_Library): Do not append "/OPTIONS" to the
	option file name, only to the --for-linker= switch.
	(Option_File_Name): If option file name do not end with ".opt", append
	"/OPTIONS".

2004-02-18  GNAT Script  <nobody@gnat.com>

	* Make-lang.in: Makefile automatically updated

From-SVN: r78024
parent c5fe5036
Showing with 422 additions and 75 deletions
gcc/ada/5gmastop.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- (Version for IRIX/MIPS) --
-- --
-- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1999-2004 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- --
......@@ -301,7 +301,25 @@ package body System.Machine_State_Operations is
-- Lock_Task is used in many other places.
Lock_Task.all;
Exc_Unwind (Scp);
-- ??? Calling exc_unwind in the current setup does not work and
-- triggers the emission of system warning messages. Why it does
-- not work remains to be investigated. Part of the problem is
-- probably a section naming issue (e.g. .eh_frame/.debug_frame).
-- Instead of letting the call take place for nothing and emit
-- messages we don't expect, we just arrange things to pretend it
-- occurred and failed.
-- ??? Until this is fixed, we shall document that the backtrace
-- computation facility does not work.
if False then
Exc_Unwind (Scp);
else
Scp.SC_PC := 0;
end if;
Unlock_Task.all;
if Scp.SC_PC = 0 or else Scp.SC_PC = 1 then
......
gcc/ada/5vml-tgt.adb
......@@ -209,7 +209,9 @@ package body MLib.Tgt is
if Symbol_Data.Symbol_File = No_Name then
return "symvec.opt";
else
return Get_Name_String (Symbol_Data.Symbol_File);
Get_Name_String (Symbol_Data.Symbol_File);
To_Lower (Name_Buffer (1 .. Name_Len));
return Name_Buffer (1 .. Name_Len);
end if;
end Option_File_Name;
......@@ -244,8 +246,7 @@ package body MLib.Tgt is
Opt_File_Name : constant String := Option_File_Name;
Version : constant String := Version_String;
For_Linker_Opt : constant String_Access :=
new String'("--for-linker=" & Opt_File_Name);
For_Linker_Opt : String_Access;
-- Start of processing for Build_Dynamic_Library
......@@ -258,6 +259,19 @@ package body MLib.Tgt is
Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
end if;
-- If option file name does not ends with ".opt", append "/OPTIONS"
-- to its specification for the VMS linker.
if Opt_File_Name'Length > 4
and then
Opt_File_Name (Opt_File_Name'Last - 3 .. Opt_File_Name'Last) = ".opt"
then
For_Linker_Opt := new String'("--for-linker=" & Opt_File_Name);
else
For_Linker_Opt :=
new String'("--for-linker=" & Opt_File_Name & "/OPTIONS");
end if;
VMS_Options (VMS_Options'First + 1) := For_Linker_Opt;
for J in Inter'Range loop
......
gcc/ada/ChangeLog
2004-02-18 Emmanuel Briot <briot@act-europe.fr>
* ali.ads, ali.adb (First_Sdep_Entry): No longer a constant, so that
Scan_ALI can be used for multiple ALI files without reinitializing
between calls.
2004-02-18 Robert Dewar <dewar@gnat.com>
* debug.adb: Minor reformatting.
2004-02-18 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* decl.c (gnat_to_gnu_entity, case object): Set DECL_POINTER_ALIAS_SET
to zero if there is an address clause.
2004-02-18 Thomas Quinot <quinot@act-europe.fr>
* exp_util.adb (Side_Effect_Free): Any literal is side effects free.
2004-02-18 Gary Dismukes <dismukes@gnat.com>
* layout.adb (Layout_Component_List): Revise generation of call to
discriminant-checking function to pass selections of all of the type's
discriminants rather than just the variant-controlling discriminant.
2004-02-18 Olivier Hainque <hainque@act-europe.fr>
* 5gmastop.adb (Pop_Frame): Do not call exc_unwind, which is bound to
fail in the current setup and triggers spurious system error messages.
Pretend it occurred and failed instead.
2004-02-18 Vincent Celier <celier@gnat.com>
* bld.adb: Mark FLDFLAGS as saved
(Process_Declarative_Items): Add Linker'Linker_Options to FLDFLAGS when
it is not the root project. Put each directory to be
extended between double quotes to prevent it to be expanded on Windows.
(Recursive_Process): Reset CFLAGS/CXXFLAGS to nothing before processing
the project file. Set them back to their initial values if they have not
been set in the project file.
* gprcmd.adb: (Gprdebug, Debug): New global variables
(Display_Command): New procedure
(Usage): Document new command "linkopts"
Call Display_Command when env var GPRDEBUG has the value "TRUE"
Implement new command "linkopts"
Remove quotes that may be around arguments for "extend"
Always call Normalize_Pathname with arguments formatted for the platform
* Makefile.generic: Link C/C++ mains with $(FLDFLAGS)
Change @echo to @$(display) in target clean to be able to clean silently
* Makefile.prolog: Save FLDFLAGS and give it an initial empty value
* prj-part.adb (Project_Path_Name_Of): Do not put final result in
canonical case.
* prj-part.adb (Parse_Single_Project): Always call with From_Extended
= Extending_All when current project is an extending all project.
* vms_conv.adb (Output_File_Expected): New Boolean global variable,
set to True only for LINK command, after Unix switch -o.
(Process_Arguments): Set Output_File_Expected to True for LINK command
after Unix switch -o. When Output_File_Expected is True, never add an
extension to a file name.
* 5vml-tgt.adb (Build_Dynamic_Library): Do not append "/OPTIONS" to the
option file name, only to the --for-linker= switch.
(Option_File_Name): If option file name do not end with ".opt", append
"/OPTIONS".
2004-02-18 GNAT Script <nobody@gnat.com>
* Make-lang.in: Makefile automatically updated
2004-02-17 Matt Kraai <kraai@alumni.cmu.edu>
* Make-lang.in (stamp-sdefault): Do not depend on
......
gcc/ada/Makefile.generic
......@@ -349,8 +349,8 @@ else
link: $(EXEC_DIR)/$(EXEC) archive-objects
$(EXEC_DIR)/$(EXEC): $(OBJ_FILES)
@$(display) $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
$(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS)
@$(display) $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS) $(FLDFLAGS)
@$(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS) $(FLDFLAGS)
endif
endif
......@@ -363,7 +363,7 @@ ifeq ($(strip $(filter-out c c++ ada,$(LANGUAGES))),)
ifeq ($(MAIN),ada)
# Ada main
link: $(LINKER) archive-objects force
@(display) $(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES)
@$(display) $(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES)
@$(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(LARGS) $(LDFLAGS)
......@@ -376,15 +376,15 @@ else
# C/C++ main
link: $(LINKER) archive-objects force
@(display) $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES)
@$(display) $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES)
@$(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS)
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS) $(FLDFLAGS)
internal-build: $(LINKER) archive-objects force
@$(display) $(GNATMAKE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) $(EXEC_RULE) \
-B -P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS)
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS) $(FLDFLAGS)
endif
else
......@@ -483,20 +483,20 @@ internal-c++ : $(CXX_OBJECTS)
.PHONY: force internal-clean internal-archive internal-build internal-compile internal-ada internal-c internal-c++ build compile clean ada c c++
internal-clean:
@echo $(RM) $(OBJ_DIR)/*$(OBJ_EXT)
@$(display) $(RM) $(OBJ_DIR)/*$(OBJ_EXT)
@$(RM) $(OBJ_DIR)/*$(OBJ_EXT)
@echo $(RM) $(OBJ_DIR)/*.ali
@$(display) $(RM) $(OBJ_DIR)/*.ali
@$(RM) $(OBJ_DIR)/*.ali
@echo $(RM) $(OBJ_DIR)/b~*
@$(display) $(RM) $(OBJ_DIR)/b~*
@$(RM) $(OBJ_DIR)/b~*
@echo $(RM) $(OBJ_DIR)/b_*
@$(display) $(RM) $(OBJ_DIR)/b_*
@$(RM) $(OBJ_DIR)/b_*
@echo $(RM) $(OBJ_DIR)/*$(AR_EXT)
@$(display) $(RM) $(OBJ_DIR)/*$(AR_EXT)
@$(RM) $(OBJ_DIR)/*$(AR_EXT)
@echo $(RM) $(OBJ_DIR)/*.d
@$(display) $(RM) $(OBJ_DIR)/*.d
@$(RM) $(OBJ_DIR)/*.d
ifneq ($(EXEC),)
@echo $(RM) $(EXEC_DIR)/$(EXEC)
@$(display) $(RM) $(EXEC_DIR)/$(EXEC)
@$(RM) $(EXEC_DIR)/$(EXEC)
endif
......
gcc/ada/Makefile.prolog
......@@ -40,6 +40,7 @@ GNATMAKE.saved:=$(GNATMAKE)
ADAFLAGS.saved:=$(ADAFLAGS)
CFLAGS.saved:=$(CFLAGS)
CXXFLAGS.saved:=$(CXXFLAGS)
FLDFLAGS.saved:=$(FLDFLAGS)
LIBS.saved:=$(LIBS)
LDFLAGS.saved:=$(LDFLAGS)
ADA_SOURCES.saved:=$(ADA_SOURCES)
......@@ -57,6 +58,7 @@ CXX_EXT:=.cc
AR_EXT=.a
OBJ_EXT=.o
CC=gcc
FLDFLAGS:=
# Default target is to build (compile/bind/link)
# Target build is defined in Makefile.generic
......
gcc/ada/ali.adb
......@@ -601,6 +601,8 @@ package body ALI is
-- Start of processing for Scan_ALI
begin
First_Sdep_Entry := Sdep.Last + 1;
-- Acquire lines to be ignored
if Read_Xref then
......
gcc/ada/ali.ads
......@@ -593,8 +593,10 @@ package ALI is
No_Sdep_Id : constant Sdep_Id := Sdep_Id'First;
-- Special value indicating no Sdep table entry
First_Sdep_Entry : constant Sdep_Id := No_Sdep_Id + 1;
-- Id of first actual entry in table
First_Sdep_Entry : Sdep_Id := No_Sdep_Id + 1;
-- Id of first Sdep entry for current ali file. This is initialized to
-- the first Sdep entry in the table, and then incremented appropriately
-- as successive ALI files are scanned.
type Sdep_Record is record
......
gcc/ada/bld.adb
......@@ -222,6 +222,7 @@ package body Bld is
Deps_Projects_String : aliased String := "DEPS_PROJECT";
Exec_String : aliased String := "EXEC";
Exec_Dir_String : aliased String := "EXEC_DIR";
Fldflags_String : aliased String := "FLDFLAGS";
Gnatmake_String : aliased String := "GNATMAKE";
Languages_String : aliased String := "LANGUAGES";
Ld_Flags_String : aliased String := "LD_FLAGS";
......@@ -251,6 +252,7 @@ package body Bld is
Deps_Projects_String'Access,
Exec_String 'Access,
Exec_Dir_String 'Access,
Fldflags_String 'Access,
Gnatmake_String 'Access,
Languages_String 'Access,
Ld_Flags_String 'Access,
......@@ -1426,7 +1428,8 @@ package body Bld is
(Pkg = No_Name
or else Pkg = Snames.Name_Naming
or else Pkg = Snames.Name_Compiler
or else Pkg = Name_Ide);
or else Pkg = Name_Ide
or else Pkg = Snames.Name_Linker);
if Put_Declaration then
-- Some attributes are converted into reserved variables
......@@ -1508,7 +1511,7 @@ package body Bld is
Put_Attribute (Project, Pkg, Item_Name, No_Name);
Put ("),$(shell gprcmd extend $(");
Put (Project_Name);
Put_Line (".base_dir) '$(name)'))");
Put_Line (".base_dir) '""$(name)""'))");
elsif Item_Name = Snames.Name_Source_Files then
......@@ -1959,6 +1962,38 @@ package body Bld is
end if;
end if;
end;
else
-- Other attribute are of no interest; suppress
-- their declarations.
Put_Declaration := False;
end if;
elsif Pkg = Snames.Name_Linker then
if Item_Name = Snames.Name_Linker_Options then
-- Only add linker options if this is not the root
-- project.
Put ("ifeq ($(");
Put (Project_Name);
Put (".root),False)");
New_Line;
-- Add the linker options to FLDFLAGS, in reverse
-- order.
Put (" FLDFLAGS:=$(shell gprcmd linkopts $(");
Put (Project_Name);
Put (".base_dir) $(");
Put_Attribute
(Project, Pkg, Item_Name, No_Name);
Put (")) $(FLDFLAGS)");
New_Line;
Put ("endif");
New_Line;
else
-- Other attribute are of no interest; suppress
-- their declarations.
......@@ -2686,6 +2721,15 @@ package body Bld is
-- Set defaults to some variables
-- CFLAGS and CXXFLAGS are set by default to nothing.
-- Their initial values have been saved, If they are not set
-- by this project file, then they will be reset to their
-- initial values. This is to avoid "inheritance" of these
-- flags from an imported project file.
Put_Line ("CFLAGS:=");
Put_Line ("CXXFLAGS:=");
IO.Mark (Src_Files_Init);
Put_Line ("src_files.specified:=FALSE");
......@@ -3345,6 +3389,19 @@ package body Bld is
end if;
end;
-- If CFLAGS/CXXFLAGS have not been set, set them back to
-- their initial values.
Put_Line ("ifeq ($(CFLAGS),)");
Put_Line (" CFLAGS:=$(CFLAGS.saved)");
Put_Line ("endif");
New_Line;
Put_Line ("ifeq ($(CXXFLAGS),)");
Put_Line (" CXXFLAGS:=$(CXXFLAGS.saved)");
Put_Line ("endif");
New_Line;
-- If this is the main Makefile, include Makefile.Generic
Put ("ifeq ($(");
......
gcc/ada/debug.adb
......@@ -470,7 +470,7 @@ package body Debug is
-- testing high integrity mode.
-- d.x No exception handlers in generated code. This causes exception
-- handles to be eliminated from the generated code. They are still
-- handlers to be eliminated from the generated code. They are still
-- fully compiled and analyzed, they just get eliminated from the
-- code generation step.
......
gcc/ada/decl.c
......@@ -1048,6 +1048,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
/* If we have an address clause and we've made this indirect, it's
not enough to merely mark the type as volatile since volatile
references only conflict with other volatile references while this
reference must conflict with all other references. So ensure that
the dereferenced value has alias set 0. */
if (Present (Address_Clause (gnat_entity)) && used_by_ref)
DECL_POINTER_ALIAS_SET (gnu_decl) = 0;
if (definition && DECL_SIZE (gnu_decl) != 0
&& gnu_block_stack != 0
&& TREE_VALUE (gnu_block_stack) != 0
......
gcc/ada/exp_util.adb
......@@ -3348,6 +3348,15 @@ package body Exp_Util is
when N_Unchecked_Expression =>
return Side_Effect_Free (Expression (N));
-- A literal is side effect free
when N_Character_Literal |
N_Integer_Literal |
N_Real_Literal |
N_String_Literal
=>
return True;
-- We consider that anything else has side effects. This is a bit
-- crude, but we are pretty close for most common cases, and we
-- are certainly correct (i.e. we never return True when the
......
gcc/ada/gprcmd.adb
......@@ -58,6 +58,10 @@ procedure Gprcmd is
-- ??? comments are thin throughout this unit
Gprdebug : constant String := To_Lower (Getenv ("GPRDEBUG").all);
Debug : constant Boolean := Gprdebug = "true";
-- When Debug is True, gprcmd displays its arguments to Standard_Error.
-- This is to help to debug.
procedure Cat (File : String);
-- Print the contents of file on standard output.
......@@ -82,6 +86,9 @@ procedure Gprcmd is
procedure Copy_Time_Stamp (From, To : String);
-- Copy file time stamp from file From to file To.
procedure Display_Command;
-- Display the invoked command to Standard_Error
---------
-- Cat --
---------
......@@ -256,6 +263,19 @@ procedure Gprcmd is
Free (Buffer);
end Deps;
---------------------
-- Display_Command --
---------------------
procedure Display_Command is
begin
for J in 0 .. Argument_Count loop
Put (Standard_Error, Argument (J) & ' ');
end loop;
New_Line (Standard_Error);
end Display_Command;
------------
-- Extend --
------------
......@@ -354,6 +374,8 @@ procedure Gprcmd is
"get the prefix of the GNAT installation");
Put_Line (Standard_Error, " path " &
"convert a directory list into a path list");
Put_Line (Standard_Error, " linkopts " &
"process attribute Linker'Linker_Options");
Put_Line (Standard_Error, " ignore " &
"do nothing");
OS_Exit (1);
......@@ -362,6 +384,10 @@ procedure Gprcmd is
-- Start of processing for Gprcmd
begin
if Debug then
Display_Command;
end if;
Check_Args (Argument_Count > 0);
declare
......@@ -408,8 +434,11 @@ begin
if Is_Absolute_Path (Argument (J)) then
Put (Format_Pathname (Argument (J), UNIX));
else
Put (Format_Pathname (Normalize_Pathname (Argument (J), Dir),
UNIX));
Put (Format_Pathname
(Normalize_Pathname
(Format_Pathname (Argument (J)),
Format_Pathname (Dir)),
UNIX));
end if;
if J < Argument_Count then
......@@ -426,17 +455,33 @@ begin
begin
for J in 3 .. Argument_Count loop
if Is_Absolute_Path (Argument (J)) then
Extend (Format_Pathname (Argument (J), UNIX));
else
Extend
(Format_Pathname (Normalize_Pathname (Argument (J), Dir),
UNIX));
end if;
if J < Argument_Count then
Put (' ');
end if;
-- Remove quotes that may have been added around each argument
declare
Arg : constant String := Argument (J);
First : Natural := Arg'First;
Last : Natural := Arg'Last;
begin
if Arg (First) = '"' and then Arg (Last) = '"' then
First := First + 1;
Last := Last - 1;
end if;
if Is_Absolute_Path (Arg (First .. Last)) then
Extend (Format_Pathname (Arg (First .. Last), UNIX));
else
Extend
(Format_Pathname
(Normalize_Pathname
(Format_Pathname (Arg (First .. Last)),
Format_Pathname (Dir)),
UNIX));
end if;
if J < Argument_Count then
Put (' ');
end if;
end;
end loop;
end;
......@@ -490,6 +535,70 @@ begin
Put (Path_Separator);
end loop;
-- Check the linker options for relative paths. Insert the project
-- base dir before relative paths.
elsif Cmd = "linkopts" then
Check_Args (Argument_Count >= 2);
-- First argument is the base directory of the project file
declare
Base_Dir : constant String := Argument (2) & '/';
begin
-- process the remainder of the arguments
for J in 3 .. Argument_Count loop
declare
Arg : constant String := Argument (J);
begin
-- If it is a switch other than a -L switch, just send back
-- the argument.
if Arg (Arg'First) = '-' and then
(Arg'Length <= 2 or else Arg (Arg'First + 1) /= 'L')
then
Put (Arg);
else
-- If it is a file, check if its path is relative, and
-- if it is relative, add <project base dir>/ in front.
-- Otherwise just send back the argument.
if Arg'Length <= 2
or else Arg (Arg'First .. Arg'First + 1) /= "-L"
then
if not Is_Absolute_Path (Arg) then
Put (Base_Dir);
end if;
Put (Arg);
-- For -L switches, check if the path is relative and
-- proceed similarly.
else
Put ("-L");
if
not Is_Absolute_Path (Arg (Arg'First + 2 .. Arg'Last))
then
Put (Base_Dir);
end if;
Put (Arg (Arg'First + 2 .. Arg'Last));
end if;
end if;
end;
-- Insert a space between each processed argument
if J /= Argument_Count then
Put (' ');
end if;
end loop;
end;
-- For "ignore" do nothing
elsif Cmd = "ignore" then
......
gcc/ada/layout.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2004 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- --
......@@ -1980,11 +1980,13 @@ package body Layout is
else
declare
EsizV : SO_Ref;
RM_SizV : Node_Id;
Dchoice : Node_Id;
Discrim : Node_Id;
Dtest : Node_Id;
EsizV : SO_Ref;
RM_SizV : Node_Id;
Dchoice : Node_Id;
Discrim : Node_Id;
Dtest : Node_Id;
D_List : List_Id;
D_Entity : Entity_Id;
begin
RM_Siz_Expr := Empty;
......@@ -2052,16 +2054,6 @@ package body Layout is
-- Otherwise construct the appropriate test
else
-- Discriminant to be tested
Discrim :=
Make_Selected_Component (Loc,
Prefix =>
Make_Identifier (Loc, Chars => Vname),
Selector_Name =>
New_Occurrence_Of
(Entity (Name (Vpart)), Loc));
-- The test to be used in general is a call to the
-- discriminant checking function. However, it is
-- definitely worth special casing the very common
......@@ -2072,6 +2064,16 @@ package body Layout is
if No (Next (Dchoice))
and then Nkind (Dchoice) /= N_Range
then
-- Discriminant to be tested
Discrim :=
Make_Selected_Component (Loc,
Prefix =>
Make_Identifier (Loc, Chars => Vname),
Selector_Name =>
New_Occurrence_Of
(Entity (Name (Vpart)), Loc));
Dtest :=
Make_Op_Eq (Loc,
Left_Opnd => Discrim,
......@@ -2083,6 +2085,25 @@ package body Layout is
-- False when the passed discriminant value matches.
else
-- The checking function takes all of the type's
-- discriminants as parameters, so a list of all
-- the selected discriminants must be constructed.
D_List := New_List;
D_Entity := First_Discriminant (E);
while Present (D_Entity) loop
Append (
Make_Selected_Component (Loc,
Prefix =>
Make_Identifier (Loc, Chars => Vname),
Selector_Name =>
New_Occurrence_Of
(D_Entity, Loc)),
D_List);
D_Entity := Next_Discriminant (D_Entity);
end loop;
Dtest :=
Make_Op_Not (Loc,
Right_Opnd =>
......@@ -2091,7 +2112,7 @@ package body Layout is
New_Occurrence_Of
(Dcheck_Function (Var), Loc),
Parameter_Associations =>
New_List (Discrim)));
D_List));
end if;
RM_Siz_Expr :=
......
gcc/ada/prj-part.adb
......@@ -840,6 +840,8 @@ package body Prj.Part is
Project_Scan_State : Saved_Project_Scan_State;
Source_Index : Source_File_Index;
Extending : Boolean := False;
Extended_Project : Project_Node_Id := Empty_Node;
A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
......@@ -1051,6 +1053,27 @@ package body Prj.Part is
Scan;
end loop;
-- See if this is an extending project
if Token = Tok_Extends then
-- Make sure that gnatmake will use mapping files
Create_Mapping_File := True;
-- We are extending another project
Extending := True;
Scan; -- scan past EXTENDS
if Token = Tok_All then
Extends_All := True;
Set_Is_Extending_All (Project);
Scan; -- scan past ALL
end if;
end if;
-- If the name is well formed, Buffer_Last is > 0
if Buffer_Last > 0 then
......@@ -1098,7 +1121,7 @@ package body Prj.Part is
begin
-- Extending_All is always propagated
if From_Extended = Extending_All then
if From_Extended = Extending_All or else Extends_All then
From_Ext := Extending_All;
-- Otherwise, From_Extended is set to Extending_Single if the
......@@ -1149,22 +1172,7 @@ package body Prj.Part is
end if;
if Token = Tok_Extends then
-- Make sure that gnatmake will use mapping files
Create_Mapping_File := True;
-- We are extending another project
Scan; -- scan past EXTENDS
if Token = Tok_All then
Extends_All := True;
Set_Is_Extending_All (Project);
Scan; -- scan past ALL
end if;
if Extending then
Expect (Tok_String_Literal, "literal string");
if Token = Tok_String_Literal then
......@@ -1205,11 +1213,11 @@ package body Prj.Part is
else
declare
From_Extended : Extension_Origin := None;
From_Ext : Extension_Origin := None;
begin
if Is_Extending_All (Project) then
From_Extended := Extending_All;
if From_Extended = Extending_All or else Extends_All then
From_Ext := Extending_All;
end if;
Parse_Single_Project
......@@ -1217,7 +1225,7 @@ package body Prj.Part is
Extends_All => Extends_All,
Path_Name => Extended_Project_Path_Name,
Extended => True,
From_Extended => From_Extended);
From_Extended => From_Ext);
end;
-- A project that extends an extending-all project is also
......@@ -1640,11 +1648,10 @@ package body Prj.Part is
else
declare
Final_Result : String :=
Final_Result : constant String :=
GNAT.OS_Lib.Normalize_Pathname (Result.all);
begin
Free (Result);
Canonical_Case_File_Name (Final_Result);
return Final_Result;
end;
end if;
......
gcc/ada/vms_conv.adb
......@@ -58,6 +58,10 @@ package body VMS_Conv is
-- if a COMMANDS_TRANSLATION switch has been encountered while processing
-- a MAKE Command.
Output_File_Expected : Boolean := False;
-- True for GNAT LINK after -o switch, so that the ".ali" extension is
-- not added to the executable file name.
package Buffer is new Table.Table
(Table_Component_Type => Character,
Table_Index_Type => Integer,
......@@ -1111,6 +1115,7 @@ package body VMS_Conv is
end if;
The_Command := Command.Command;
Output_File_Expected := False;
-- Give usage information if only command given
......@@ -1277,6 +1282,7 @@ package body VMS_Conv is
elsif Arg.all = "/?" then
Display_Command := True;
Output_File_Expected := False;
-- Copy -switch unchanged
......@@ -1284,6 +1290,11 @@ package body VMS_Conv is
Place (' ');
Place (Arg.all);
-- Set Output_File_Expected for the next argument
Output_File_Expected :=
Arg.all = "-o" and then The_Command = Link;
-- Copy quoted switch with quotes stripped
elsif Arg (Arg'First) = '"' then
......@@ -1297,6 +1308,8 @@ package body VMS_Conv is
Place (Arg (Arg'First + 1 .. Arg'Last - 1));
end if;
Output_File_Expected := False;
-- Parameter Argument
elsif Arg (Arg'First) /= '/'
......@@ -1357,8 +1370,12 @@ package body VMS_Conv is
Place (' ');
Place_Lower (Normal_File.all);
-- Add extension if not present, except after
-- switch -o.
if Is_Extensionless (Normal_File.all)
and then Command.Defext /= " "
and then not Output_File_Expected
then
Place ('.');
Place (Command.Defext);
......@@ -1488,9 +1505,15 @@ package body VMS_Conv is
end case;
end if;
-- Reset Output_File_Expected, in case it was True
Output_File_Expected := False;
-- Qualifier argument
else
Output_File_Expected := False;
-- This code is too heavily nested, should be
-- separated out as separate subprogram ???
......
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