Fix for issue 550

test/f90_correct/inc/ch09.mk

@@ -0,0 +1,39 @@
+#
+# Copyright (c) 2015-2019, NVIDIA CORPORATION.  All rights reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+
+########## Make rule for test ch09  ########
+
+
+ch09: run
+
+
+build:  $(SRC)/ch09.f90
+	-$(RM) ch09.$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
+	@echo ------------------------------------ building test $@
+	-$(CC) -c $(CFLAGS) $(SRC)/check.c -o check.$(OBJX)
+	-$(CC) -c $(CFLAGS) $(SRC)/ch09_print.c -o ch09_print.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/ch09.f90 -o ch09.$(OBJX)
+	-$(FC) $(FFLAGS) $(LDFLAGS) ch09.$(OBJX) check.$(OBJX) ch09_print.$(OBJX) $(LIBS) -o ch09.$(EXESUFFIX)
+
+
+run:
+	@echo ------------------------------------ executing test ch09
+	ch09.$(EXESUFFIX)
+
+verify: ;
+
+ch09.run: run
+

test/f90_correct/lit/ch09.sh

@@ -0,0 +1,19 @@
+#
+# Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+#     http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+# Shared lit script for each tests. Run bash commands that run tests with make.
+
+# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
+# RUN: cat %t | FileCheck %S/runmake

test/f90_correct/src/ch09.f90

@@ -0,0 +1,28 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+!
+! Issue 550: bind attribute is a concatenated expression
+! 
+
+program main
+  implicit none
+  interface
+    subroutine go_print(f) bind(C,name="my_"//"printing")
+      CHARACTER(len=1) :: f
+    end subroutine
+  end interface
+
+  call go_print("Something "//"to print")
+end program
+

test/f90_correct/src/ch09_print.c

@@ -0,0 +1,17 @@
+
+#include <stdio.h>
+#include <string.h>
+
+extern void check(int* res, int* exp, int* np);
+
+void my_printing(char * to_print) {
+    printf("%s\n", to_print);
+    int one[1] = {1};
+    int zero[1] = {0};
+    if (strcmp(to_print, "Something to print") == 0 ) {
+        check(one, one, one);
+    } else {
+        check(zero, one, one);
+    }
+}
+

tools/flang1/flang1exe/semant.c

@@ -7985,7 +7985,7 @@ semant1(int rednum, SST *top)
     bind_attr.altname = 0;
 
     np = scn.id.name + SST_CVALG(RHS(2));
-    if (sem_strcmp(np, "c") != 0) {
+    if (sem_strcmp(np, "c") != 0 || SST_IDG(RHS(6)) != S_CONST) {
       error(4, 3, gbl.lineno, "Illegal BIND -", np);
     } else {
       bind_attr.exist = DA_B(DA_C) | DA_B(DA_ALIAS);

tools/flang1/utils/prstab/gram.txt

@@ -536,7 +536,7 @@
 	   MANAGED
 
 <bind attr> ::= ( <id name> ) |
-		( <id name> , <id name> = <quoted string> )
+		( <id name> , <id name> = <char expr> )
 
 <bind list> ::=  <bind list> , <bind entry> |
 		 <bind entry>